Outlook 2013 doesn't send mails leaving them in outbox folder with "Sent" field showi-CodePudding

I'm using MS-Word (2013) to create mass mail (mail merge), which I want to add attachements to before sending off. For that reason, I set Outlook (2013) into offline mode before running mail merge in Word. The mails are put into Outlook's outbox folder. Next, I'm running a VBA script (see below), to add attachements. So far, everything works fine.

Then I switch Outlook back to online mode, and the mails should get sent off. They don't, and a can't convince Outlook to send them mails no matter what I try (except from openng and hitting Send for each individual mail, which is not an option because of the number of mails.)

I'm only running this process once a year, last year having been the first round. It worked fine then, but not now. Except from standard MS-Office updates, I can't seem to understand what has changed.

I noticed that the mails in the outbox show the current date in column "Sent" ("Gesendet") before running the script. This changes to "Ohne" ("Without", or "None" in the English version?). I suspect that this might be the reason the mails are not sent off. But why this change from current date to "Ohne"? But more of interest: Is there anything I need to change in the VBS script?

Sub addAttachmentsToMailsInOutbox()

'   This VB script adds one or more files as attachment to each and every mail if finds in the
'   outbox. It is thought to be used with mechanism to create multiple mails with same attachments,
'   e.g. via Word's Mail Merge, when the mechanism does not support adding attachments (and Word
'   doesn't).
'
'   USAGE
'   -----
'   1. Set Outlook to 'Offline' mode, so that mails will be kept in the Outbox folder.
'   2. Create the mails, e.g. using Word Mail Merge.
'   3. Run this script from within Outlook.
'   4. Verify the result.
'   5. Set Outlook to 'Online' mode, so that the mails will be sent off.


    Dim olNs As Outlook.NameSpace
    Dim olOutbox As Outlook.MAPIFolder
    Dim olItem As Object
    

    Set olNs = GetNamespace("MAPI")
    Set olOutbox = olNs.GetDefaultFolder(olFolderOutbox)
    

   ' Check if there is any messages at all. Quit if none.
    If olOutbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Outbox." & Chr(13) & Chr(13) _
            & "Did you set Outlook into 'Offline' mode before generating the mails?" & Chr(13) _
            & "If not, mails were sent off before we're able to modify them." _
            , vbExclamation
       Exit Sub
    End If

    MsgBox "A file selection dialog with title 'Select file(s) to attacht to the mails...' will open " _
        & "eventually once this message has been closed." & Chr(13) & Chr(13) _
        & "Be patient, it may take a little while. It may open in the background." & Chr(13) _
        & "Also note that the dialog will have an MS-Word icon. This is expected; don't be confused." _
        , vbInformation
        
    
    ' Using File Open dialog from Word, since Outlook doesn't provide one for VBA code.
    Set ObjWord = CreateObject("Word.Application")
    ObjWord.ChangeFileOpenDirectory ("D:\")
    ObjWord.FileDialog(msoFileDialogOpen).Title = "Select file(s) to attach to the mails..."
    ObjWord.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
    
    okEscape = False
      
    If ObjWord.FileDialog(1).Show = -1 Then
        If ObjWord.FileDialog(1).SelectedItems.Count > 0 Then
            okEscape = True
        End If
    End If
    
    If Not okEscape Then
        ObjWord.Quit
        MsgBox "Cancel was pressed, no attachments will be added.", vbExclamation
        Exit Sub
    End If

    filesSelected = " ->  "
    nl = ""

    For Each objfile In ObjWord.FileDialog(1).SelectedItems
        filesSelected = filesSelected & nl & objfile
        nl = Chr(13) & " ->  "
    Next
    
    If (MsgBox("Following files were selected:" & Chr(13) _
        & filesSelected & Chr(13) & Chr(13) _
        & "Do you want to continue?" _
        , vbQuestion   vbYesNo) = vbNo) Then
        ObjWord.Quit
        Exit Sub
    End If
        

    ' Make sure the mails are in HTML format. Even though they might aready be, this loop helps
    ' to prevent a persmission problem (error 80070005) that will occur when attching in below loop.
    ' It is not clear what this changed, but the solution was found with some help on Stackoverlfow.com
    
    For Each olItem In olOutbox.Items
        If olItem.Class = olMail Then
            With olItem
                .BodyFormat = olFormatHTML
                .Save
            End With
        End If
    Next
    
    For Each olItem In olOutbox.Items
        If olItem.Class = olMail Then
            For Each objfile In ObjWord.FileDialog(1).SelectedItems
               With olItem
                    .Attachments.Add (objfile)
                    .Save
                End With
            Next
        End If
    Next
    
    ObjWord.Quit

    
    MsgBox "Selected file(s) have been attached to the mails in the Outbox." & Chr(13) & Chr(13) _
        & "Verify the result, and then don't forget to switch to 'Online' mode, so that the mails will be sent off!" _
        , vbExclamation   vbOKOnly
        
End Sub

CodePudding user response：

Shortly after posting, I read a thread about something else, but which mentioned mails having the "draft" icon. This pointed me to the solution: I need to "send" each mail item from within the VBS after having added the last attchement. So this loop:

    For Each olItem In olOutbox.Items
        If olItem.Class = olMail Then
            For Each objfile In ObjWord.FileDialog(1).SelectedItems
               With olItem
                    .Attachments.Add (objfile)
                    .Save
                End With
            Next
        End If
    Next

becomes:

    For Each olItem In olOutbox.Items
        If olItem.Class = olMail Then
            For Each objfile In ObjWord.FileDialog(1).SelectedItems
               With olItem
                    .Attachments.Add (objfile)
                    .Save
                End With
            Next
            
            olItem.Send         ' Need to explicitly send again.
        End If
    Next

This doesn't explain how it worked last year, but anyway, it is working again.

CodePudding user response：

Never access messages being submitted (in the Outbox folder) - touching them with the Outlook Object Model or the Outlook UI aborts the submission process and you must explicitly resend them. If you need to make any modifications to the message before they are sent, Application.ItemSend event if your last chance to do that.