Outlook VBA (VBA)

Gerrit Viehmann @, Dienstag, 04.09.2018, 22:02 (vor 74 Tagen) @ Dany

Hallo Dany,

hier eine Funktion, die in Access Access-VBA VBA funktioniert:

Public Sub OutlookNeueMail(ByVal Empfänger As String, Betreff As String, Optional Inhalt As String, Optional Cc As String = "", _
                           Optional Versender As String = "", Optional Antwortadresse As String = "", Optional alsHTML As Boolean = False, _
                           Optional istModal As Boolean = False, Optional MitStdSignatur As Boolean = False, Optional AnhangURIs As String = "")
    ' Erstellt eine E-Mail und zeigt diese in Outlook an.
    ' MitStdSignatur benötigt Mitwirkung des Benutzers (Sicherheitsabfrage) und setzt voraus, dass neue Nachrichten eine Signatur haben.

1   On Error GoTo OutlookNeueMail_Error
 
    Dim OlApp As Object
2   Set OlApp = CreateObject("Outlook.Application")
    Dim mail As Object
3   Set mail = OlApp.CreateItem(0)     ' olMailItem=0

4   If MitStdSignatur Then
5       mail.BodyFormat = 2            ' olFormatHTML=2
6       mail.GetInspector              ' Erzeugt E-Mail mit Signatur, wenn das der Standard für neue E-Mails ist.
        Dim Signatur
7       On Error Resume Next
8       Signatur = mail.HTMLBody
9       On Error GoTo OutlookNeueMail_Error
10  End If
 
11  mail.Importance = 1                ' olImportanceNormal=1
12  If Empfänger <> "" Then mail.To = Empfänger    ' Namen der Empfängerliste werden nicht geprüft
13  If Cc <> "" Then mail.Cc = Cc
14  mail.Subject = Nz(Betreff)         ' Nz() setzt Access voraus. Ggf. durch if-Statement ersetzen.
15  If Inhalt <> "" Then
16      If alsHTML Then
17          mail.BodyFormat = 2        ' olFormatHTML=2
18          mail.HTMLBody = Inhalt & Signatur
19      Else
20          mail.BodyFormat = 1        ' olFormatPlain=1
21          mail.Body = Inhalt & PlainText(Signatur)   ' PlainText() setzt Access voraus.
22      End If
23  End If
 
24  If Versender <> "" Then
25      mail.SentOnBehalfOfName = Versender
26  End If
27  If Antwortadresse <> "" Then
28      mail.ReplyRecipientNames = Antwortadresse
29  End If
 
30  If AnhangURIs <> "" Then
        ' Attachments hinzufügen
        Dim Anlagen, Anlage
31      Anlagen = Split(AnhangURIs, "|")    ' mehrerere Dateien müssen bereits mit senkrechtem Strich (ohne folgendes Leerzeichen) getrennt sein
32      For Each Anlage In Anlagen
33          If Anlage <> "" Then mail.Attachments.Add Trim(Anlage)
34      Next Anlage
35  End If
 
36  mail.Display (istModal)            ' True=Behält den Fokus bis zum Schliessen.

Ausgang:
37  Set mail = Nothing
38  Set OlApp = Nothing
39  Exit Sub
 
OutlookNeueMail_Error:
40  MsgBox "Fehler beim Erstellen einer neuen E-Mail mit Outlook:" & vbCrLF _
            & Err.Description & vbCrLf _
            & "Zeile " & Erl() & " in Sub OutlookNeueMail()"
41  Resume Ausgang
End Sub

Vielleicht genügt dies ja schon für Deine Zwecke.
Beispiel:
OutlookNeueMail "Kunde@kundendomain.ch", "Rechnung...", Inhalt:= "SGDH, ... mfg", Versender:="logistik@meinefirma.ch", Antwortadresse:="buchaltung@meinefirma.ch", AnhangURIs:="D:\Output\Rechnung_00000.pdf"

Wenn man nicht der Versender selber ist, muss man das Senden-Als Recht vom spezifizierten Postfach haben.

Mit

mail.send

könntest Du auch die E-Mail gleich versenden. Wenn ich mich recht erinnere, greift da aber der Spamschleuder-Schutz und der Outlook-Benutzer muss das freigeben.

Viele Grüße
Gerrit Viehmann


gesamter Thread:

 RSS-Feed dieser Diskussion

powered by my little forum