dinsdag 20 januari 2015

Excel: Outlook aanroepen en ook daadwerkelijk openen met VBA

Om vanuit Excel met VBA een e-mail te versturen is niet zo ingewikkeld. Code is overal te vinden. Ik toon hier een voorbeeld van de website van Ron de Bruin:

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Als we Display gebruiken wordt wel de Outlook e-mail getoond maar niet Outlook zelf. Als we bijvoorbeeld vanuit Excel een Word document willen openen en Word ook echt willen tonen, kunnen we zoiets gebruiken:

Set wordapp = CreateObject("word.Application")
wordapp.documents.Open "D:\data\hessel.docx"
wordapp.Visible = True

Voor verder Excel tips klik hier.
Een simpel instellen van Visible op True volstaat. Om Outlook ook echt te openen, moeten we veel meer kluchten uithalen. Met onderstaande code lukt dit:

'outlook aanroepen en mailtje maken
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err.Number <> 429 Then
        'onderstaande code maakt Outlook ook echt zichtbaar te maken in combinatie met activate
        With GetObject(, "Outlook.application")
            Set objNSP = .GetNamespace("MAPI").GetDefaultFolder(6).Items.Count
        End With
    End If
    
    
    'als Outlook niet geopend, outlook openen en aanroepen
    If Err.Number = 429 Then
        Set OutApp = CreateObject("Outlook.Application")
        'onderstaande code maakt Outlook ook echt zichtbaar te maken in combinatie met activate
        With CreateObject("Outlook.application")
            Set objNSP = .GetNamespace("MAPI")
            Set objFld = objNSP.GetDefaultFolder(6) ' 6 = olFolderInbox
            Set objExp = .Explorers.Add(objFld, 0) ' 0 = olFolderDisplayNormal
        End With
    End If

    'om Outlook ook echt te tonen
    objExp.Activate
        
    'email item maken
    Set OutMail = OutApp.CreateItem(0)

    'versturen mail
    With OutMail
        .To = "hesseldewalle@gmail.com"
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        'om de email te tonen
        .display
    End With

Een reactie plaatsen