Outlook: eerste mail gemaakt mbv late binding en Outlook.Inspector toont geen body.

Sub SendTheMails()
Dim iSendingAccount As Integer
Dim iSendType As Integer
Dim Ii, i, t, tmp, cTxt
Dim strArray() As String
Dim intCount As Integer
Dim sPath As String, sFile As String, sEmail As String
Dim msgIntro As String
    
    
    cTxt = "0 - e-mail tonen en handmatig verzenden" & vbCrLf & _
           "1 - e-mail niet tonen, direct verzenden"
    Ii = InputBox(Title:="E-mail eerst tonen voor batch verzenden", _
                             Prompt:="Kies het nummer voor de actie:" & vbCrLf & cTxt, _
                             Default:=0)
    If (Ii = "") Or (Not (Ii >= 0)) Then Exit Sub
    iSendType = Ii

    
    cTxt = ListallAccounts
    i = InputBox(Title:="E-mail account voor batch verzenden", _
                             Prompt:="Kies het nummer van de afzender:" & vbCrLf & cTxt, _
                             Default:=0)
    If (i = "") Or (Not (i > 0)) Then Exit Sub
    iSendingAccount = i
    
'   Allow the user to write a short intro and put it at the top of the body
    msgIntro = InputBox("Write a short intro to put above your default " & _
                "signature and current document." & vbCrLf & vbCrLf & _
                "Press Cancel to create the mail without intro and " & _
                "signature.", "Intro", "Deze e-mail is automatisch samengesteld.")

    Application.ScreenUpdating = False
    
    For t = LBound(aEmailAddress) To UBound(aEmailAddress)
      If Not (Trim(aEmailAddress(t)) = "") Then
        'prep for sending
        strArray = Split(aEmailAddress(t), cDelimiter)
        sPath = strArray(0)
        sFile = strArray(1) & ".docx"
        sEmail = strArray(2)
        Documents.Open FileName:=sPath & sFile, ReadOnly:=True
        Documents(sFile).Activate
        
        'sending the email...
        SendDocAsMail iSendType, iSendingAccount, sEmail, msgIntro, sSubject
     
     End If
    Next t
    
    'closing single documents sent...
    For t = LBound(aEmailAddress) To UBound(aEmailAddress)
      If Not (Trim(aEmailAddress(t)) = "") Then
        strArray = Split(aEmailAddress(t), cDelimiter)
        sPath = strArray(0)
        sFile = strArray(1) & ".docx"
        sEmail = strArray(2)
        Documents(sFile).Activate
        ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
     End If
    Next t

    Documents(sBrieven).Activate
    
    Application.ScreenUpdating = True
End Sub

Sub SendDocAsMail(ByVal iSendType As Integer, ByVal iSendingAccount As Integer, _
                    sEmail As String, msgIntro As String, cSubject As String)
'late binding...
Const IsNothing = ""
Dim oOutlookApp As Object
Dim oItem As Outlook.MailItem
Dim i As Integer

On Error Resume Next

'Start Outlook if it isn't running
  Set oOutlookApp = GetObject(, "Outlook.Application")
  If Err <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
  End If

'Create a new message
  Set oItem = oOutlookApp.CreateItem(olMailItem)

'Copy the open document
  Selection.WholeStory
  Selection.Copy
  Selection.End = True

'Set the WordEditor
Dim objInsp As Outlook.Inspector
Dim wdEditor As Word.Document

  Set objInsp = oItem.GetInspector
  Set wdEditor = objInsp.WordEditor

'Write the intro if specified
  If (msgIntro = IsNothing) Then
    i = 1
    'Comment the next line to leave your default signature below the document
    wdEditor.Content.Delete
  Else
    'Write the intro above the signature
    wdEditor.Characters(1).InsertBefore (msgIntro)
    i = wdEditor.Characters.Count
    wdEditor.Characters(i).InlineShapes.AddHorizontalLineStandard
    wdEditor.Characters(i + 1).InsertParagraph
    i = i + 2
  End If

'Place the current document under the intro and signature
  wdEditor.Characters(i).PasteAndFormat (wdFormatOriginalFormatting)

'Display the message
    With oItem
      .SendUsingAccount = oOutlookApp.Session.Accounts.Item(iSendingAccount)
      .To = sEmail 'Cell.Value
      .CC = ""
      .BCC = ""
      .Subject = cSubject
'      .Body = taken care of by: wdEditor.Characters(i).PasteAndFormat (wdFormatOriginalFormatting)
      If (iSendType <> 1) Then
        .Display
      Else
        .Send
      End If
    End With

    oItem.WindowState = olMinimized
    objInsp.WindowState = olMinimized

'Clean up
  Set oItem = Nothing
  Set oOutlookApp = Nothing
  Set objInsp = Nothing
  Set wdEditor = Nothing

End Sub