Alle concepten versturen in Outlook

<< Klikken om de inhoudsopgave te openen >>

Navigatie:  Rapporten >

Alle concepten versturen in Outlook

When creating E-mails from Mill7, it is possible to save them as drafts.

 

By default it is not possible to send all E-mails that are saved to your drafts folder in Outlook.

There is however a script that can be added to Outlook.

 

Setup

 

Stap 1:

 

In outlook: File > Options > Trust center > Trust center settings > Macro settings > Notification for all macros

 

Stap 2:

 

Houd de ALT toets ingedrukt en druk dan op F11  om de Microsoft Visual Basic for Applications te openen.

 

Stap 3:

Druk dan op Insert > Module, copy en plak de code hieronder in het lege module scherm:

 

Sub SendSelectedDraftEmails()

Dim xSelection As Selection

Dim xPromptStr As String

Dim xYesOrNo As Integer

Dim i As Long

Dim xAccount As Account

Dim xCurFld As Folder

Dim xDraftsFld As Folder

Dim xTmpFld As Folder

Dim xArr() As String

Dim xCount As Integer

Dim xMail As MailItem

On Error Resume Next

xCount = 0

Set xTmpFld = Nothing

Set xCurFld = Application.ActiveExplorer.CurrentFolder

For Each xAccount In Outlook.Application.Session.Accounts

   Set xDraftsFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)

   If xDraftsFld.EntryID = xCurFld.EntryID Then

       Set xTmpFld = xCurFld.Parent

   End If

Next xAccount

If xTmpFld Is Nothing Then

   MsgBox "The current folder is not a draft folder", vbInformation, "Kutools for Outlook"

   Exit Sub

End If

Set xSelection = Outlook.Application.ActiveExplorer.Selection

If xSelection.Count > 0 Then

   xPromptStr = "Are you sure to send out the selected " & xSelection.Count & " draft item(s)?"

   xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")

   If xYesOrNo = vbYes Then

       ReDim xArr(xSelection.Count - 1)

       For i = 1 To xSelection.Count

           xArr(i - 1) = xSelection.Item(i).EntryID

       Next

       Set Application.ActiveExplorer.CurrentFolder = xTmpFld

       VBA.DoEvents

       For i = 0 To UBound(xArr)

           Set xMail = Application.Session.GetItemFromID(xArr(i))

           If xMail.Recipients.Count <> 0 Then

               xMail.sEnd

               xCount = xCount + 1

           End If

       Next

       VBA.DoEvents

       Set Application.ActiveExplorer.CurrentFolder = xCurFld

       MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"

   End If

Else

   MsgBox "No items selected!", vbInformation, "Kutools for Outlook"

End If

End Sub

 

Stap 4:

Save en sluit het scherm.

 

Stap 5:

Herstart Outlook om de settings in te laten gaan.

 

 

Run

1.        Ga naar de concepten folder en selecteer de mails welke je wilt versturen.

2.        Druk op ALT-F11

3.        Het scherm opent nu met het script, druk op F5.

4.        Druk op Yes

5.        Klaar!