mindwalzer

Mails per Makro senden

Kann man per Makro auch Mails senden unter Verwendung des Standard-Mailclients unter Windows? Man kann!

Hier ein Beispiel, in dem sämtliche Mail-Adressen auf Zweigen in einer Map gesucht werden und daraus der Mail-Client geöffnet wird, so dass eine Mail an alle gefundenen Adressen gesendet werden kann:

Option Explicit
Private Const SW_SHOW = 5

Dim WithEvents iterator As TopicFinder
Dim MailAdressen As String

Sub Main
	Dim mmT As Topic
	Dim MailPrefix As String

	Set mmT = ActiveDocument.CentralTopic
	Set iterator = mmT.NewTopicFinder
	MailAdressen = ""

	iterator.Start

	MailPrefix = ""
	'MailPrefix = "&cc="		'Mail als CC-Kopie senden
	'MailPrefix = "&bcc="		'Mail als BCC-Kopie senden

	OpenEmail(MailPrefix & MailAdressen, "", "")
End Sub


Private Sub iterator_TopicFound (t As Topic)
	If t.HasHyperlink Then
		If Left(t.Hyperlink.Address, 7) = "mailto:" Then
			MailAdressen = MailAdressen & Replace(t.Hyperlink.Address, "mailto:", "") & "; "
		End If
	End If

End Sub



Private Function OpenEmail(ByVal EmailAddress As String, _
    Optional Subject As String, Optional Body As String) _
    As Boolean

    Dim lWindow As Long
    Dim lRet As Long
    Dim sParams As String

    sParams = EmailAddress
    If LCase(Left(sParams, 7))  "mailto:" Then _
        sParams = "mailto:" & sParams

 If Subject  "" Then sParams = sParams & "?subject=" & Subject

    If Body  "" Then
        sParams = sParams & IIf(Subject = "", "?", "&")
        sParams = sParams & "body=" & Body
    End If

   lRet = ShellExecute(lWindow, "open", sParams, "", "", SW_SHOW)

   OpenEmail = lRet = 0

End Function

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters _
As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Böse böse,

Nach dem Prinzip lief doch das"i love You" Teil. Man man und sowas hier auf ner Website...