title image


Smiley War mal im Forum ...


Sub Email_Aus_Excel_Mit_Outlook()

Dim EmailEmpfänger As String, EmailBetreff As String

Dim EmailMsg As String

Dim ZeileNr As Integer

'Outlook wird geöffnet

Set myOlApp = CreateObject("Outlook.Application")

'Fenster für neue Mail wird geöffnet

Set MailItem = myOlApp.CreateItem(olMailItem) ' opens new email

On Error GoTo ErrorHandler

' Daten z.B. in Zeilen 2 bis 4, Spalten 1 bis 6

For ZeileNr = 2 To 4

' Emailadressen werden aus Zeile 2 bis 4 ausgelesen

EmailEmpfänger = Cells(ZeileNr, 2)

' Betreff der Nachricht

EmailBetreff = Cells(ZeileNr, 3)

' Aufbau der Nachricht

EmailMsg = ""

EmailMsg = EmailMsg & Cells(ZeileNr, 4) & Cells(ZeileNr, 1) & "," & vbCrLf &

vbCrLf

EmailMsg = EmailMsg & Cells(ZeileNr, 5).Text & "." & vbCrLf & vbCrLf

EmailMsg = EmailMsg & Cells(ZeileNr, 6).Text & ". ( " & Now & " ) " & vbCrLf

& vbCrLf

EmailMsg = EmailMsg & "Dein Name" & vbCrLf

EmailMsg = EmailMsg & "Deine Anrede/Titel/Berufsbezeichnung"

' Empfänger der Mail wird in das Adressfeld "An:" geschrieben

Set myRecipient = MailItem.Recipients.Add(EmailEmpfänger)

' Betreff der Mail wird in das Feld "Betreff:" geschrieben

MailItem.Subject = EmailBetreff

' Der Text der Nachricht wird übertragen

MailItem.Body = EmailMsg

' Anlage wird angehängt

Set myAttachments = MailItem.Attachments.Add("Pfad&Dateiname")

MailItem.Send 'Email wird gesendet

Next ZeileNr

' Outlook wird geschlossen und das Makro nach einer Pause

' von 2 Sekunden fortgesetzt >> um Ressourcenprobleme zu vermeiden.

myOlApp.Quit

Application.Wait (Now + TimeValue("0:00:02"))

Exit Sub

ErrorHandler:

MsgBox vbTab & "Eine E-Mail an die Adresse " & vbCrLf & vbCrLf & _

vbTab & EmailEmpfänger & vbCrLf & vbCrLf & _

"kann leider NICHT automatisch versendet werden."

End Sub


Hilft's !?

Any - Auf gute Fragen ... folgen bessere Antworten --




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: