Email mit vba aus Excel + Text aus Word

Hallo zusammen,

ich bin gerade dabei VBA zu lernen und würde gerne testen, wie man mit Outlook automatisch Emails versenden kann. Hierzu habe ich entsprechende Empfänger (Adresese, Vorname, Nachname und Betreff) in Excel. Einen entsprechenden Email-Text (inkl. Absatz und Textformatierung) habe ich in Word vorliegen. Kann man das irgendwie kombinieren?

Ich habe im Netz bislang nur Lösungen gefunden, wie man Emails versenden kann, bei denen alles in Excel oder dem VBA vorliegt.

z.B. diese hier:

Sub Excel_Serial_Mail()
Dim MyOutApp As Object, MyMessage As Object
Dim i As Long
'Start der Sendeschleife an 10 Empfänger
For i = 1 To 10
    Set MyOutApp = CreateObject("Outlook.Application")
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        'Die Empfänger stehen in Spalte A ab Zeile 1
        .To = Cells(i, 1) 'E-Mail Adresse
        'Der Betreff in Spalte B
        .Subject = Cells(i, 2) '"Betreffzeil"
        'Der zu sendende Text in Spalte C
        'Maximal 1024 Zeichen
        'Der Text wird ohne Formatierung übernommen
        .Body = Cells(i, 3)
        'Hier wird die Mail angezeigt
        '.Display
        'Hier wird die Mail gleich in den Postausgang gelegt
        .Send
    End With
    'Objectvariablen leeren
    Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
    Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
    'Sendepause einschalten
    'Outlook kann die Aufträge nicht schnell genug verarbeiten
    Application.Wait (Now + TimeValue("0:00:05"))
Next i
End Sub

Answer 1

[PauleVBA]

Und für den Fall, dass es tatsächlich ohne Anhang sein muss , kommt hier der Code.

Allerdings werden außer Absatzmarken keine weiteren Formatierungsmerkmale übertragen. Andere Schrift oder -größe oder Tabellen oder Unterstriche... fallen weg, bzw werden durch kryptische Zeichen ersetzt. Musst Du ausprobieren: Setz vor das .Send ein Hochkomma und entferne es in der Zeile davor bei .Display, dann kannst Du die Mail betrachten, ohne sie zu senden.

Zudem habe ich die Schleife angepasst, sie liest jetzt nicht eine feste Anzahl Empfänger ein, sondern nur bis zur letzten benutzten Zeile.

Sub Mail_direct()
Dim obj_wdApp As Word.Application
Dim obj_wdDoc As Word.Document
Dim strDocName As String
Dim strMessage
Dim MyOutApp As Object, MyMessage As Object
Dim i As Long

'eine Wordumgebung anbinden
Set obj_wdApp = CreateObject("Word.Application")
'die .Doc öffnen (Pfad & Namen anpassen!)
strDocName = "D:\!Privat\Lustige_Preise.doc"

Set obj_wdDoc = obj_wdApp.Documents.Add(Template:=strDocName)
'allerdings Fenster auf Taskleite verkleinern
obj_wdApp.WindowState = wdWindowStateMinimize
'Sichtbar machen (in die Taskleiste)
obj_wdApp.Visible = True
With obj_wdApp
  ' im Word-Doc an den Anfang gehen     
 .Selection.HomeKey Unit:=wdStory
 ' Das ganze Doc auswählen      
 .Selection.WholeStory
  ' Die Auswahl in eine Variable kopieren
  strMessage = .Selection.FormattedText
  'oder strMessage = .Selection.Text  
  'ist Wurst, da keine Formatierungen übertragen werden
End With

'Start der Sendeschleife an alle Empfänger
For i = 1 To ActiveSheet.Range("A:A").SpecialCells(xlCellTypeLastCell).Row
    Set MyOutApp = CreateObject("Outlook.Application")
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        'Die Empfänger stehen in Spalte A ab Zeile 1
        .To = Cells(i, 1) 'E-Mail Adresse
        'Der Betreff in Spalte B
        .Subject = Cells(i, 2) '"Betreffzeile"
        'Der zu sendende Text in Spalte C
        'Maximal 1024 Zeichen
        'Der Text wird ohne Formatierung übernommen
        .Body = strMessage
        'Hier wird die Mail angezeigt
''        .Display
        'Hier wird die Mail gleich in den Postausgang gelegt
        .Send
    End With


    'Die .doc aus Excel-Sitzung entfernen
    Set obj_wdDoc = Nothing
    'die Word-Instanz aus Excel entfernen (Sonst bleiben Reste in der Taskliste!)
    Set obj_wdApp = Nothing
    'Objectvariablen leeren
    Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
    Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
    'Sendepause einschalten
    'Outlook kann die Aufträge nicht schnell genug verarbeiten
    Application.Wait (Now + TimeValue("0:00:05"))

Next i
End Sub

Hoffe es hilft

Comments

[schelmor]

Vielen Dank! Mit deinen letzten (beiden) Antworten konntest du mir weiterhelfen! :)

[PauleVBA]

@schelmor

Danke fürs Sternchen

Answer 2

[PauleVBA]

Wie maximilianus schon schreibt, kann man zusätzlich zu Excel eine Instanz von Word öffnen, dort ein Dokument (ggf. nur einen Teil) kopieren und dann bei Body einfügen:

Body  = "Dies ist der Text, der als Nachricht verschickt wird"
'oder
Body = strMeineVariable

Um dir weiter zu helfen, müssen wir hier also wissen, ist es ein ganzes Doc, nur immer der selbe Teil eines Doc, ein Doc mit aneinander gereihten Textteilen für verschiedene Empfänger.....

Wie stelle ich im Doc fest, welchen Teil ich kopieren soll (Absatz, Zelle eine Tabelle, Seite, Zeile, .............)?

usw.

Ob dabei auch alle Formatierungen übertragen werden, kann ich ohne Versuch nicht sagen, aber hier zu Hause läuft kein Outlook, nur auf Arbeit. Ich gehe eher davon aus, dasss bis auf die Absatzmarken alle Formatierungen entfernt werden.

Comments

[schelmor]

Zunächst einmal danke für die Antwort.

Es ginge um ein vollständiges Dokument, dass für alle Empfänger gleich wäre. Dokument ist natürlich richtig, aber es handelt sich eignetlich lediglich um mehrere Textabsätze, die insgesamt einen Umfang von 2-3 Seiten haben.

Ich werde mir deine Antworten mal genauer anschauen und einfach mal ein wenig probieren.

Viele Grüße

Answer 3

[maximilianus7]

also zunächst mal kann man aus outlook VBA heraus eine mail verschicken:

Sub senden_mail() '
       
  Dim objOL As Outlook.Application
  Dim objMail As MailItem
  Set objOL = New Outlook.Application
  Set objMail = objOL.CreateItem(olMailItem)
  With objMail
   .To = "[e-mail]"
    .Subject = "Produktefreigabe"
    .HTMLBody = "<font face =Arial,size=2>Text1,<br>  Text2<br>Text3.<br><br>  Mit freundlichen Grüssen<br><br> abulix </font>"
    '' .Attachments.Add ActiveDocument.FullName
    .Send
  
  End With
  
  Set objMail = Nothing
  Set objOL = Nothing     
End Sub

gefunden in:
http://atnotes.de/index.php?topic=22631.0;prev_next=next

mit

Dim appWD As Word.Application 
Set appWD = CreateObject("Word.Application") 

kannst du vorher auf Word zugreifen.

Comments

[schelmor]

Vielen Dank für deine Antwort.

Ich muss mir das nun mal genauer anschauen und anschließend einfach etwas experimentieren.

Viele Grüße

Answer 4

[PauleVBA]

Also, mit VBA lässt sich kein formatierter Text übertragen!

Da bleibt Dir nur, den Text als Word-(pdf-)Dokument anzuhängen und in Spalte C zu schreiben:

Bitte lesen Sie die Nachricht im angefügten Word-Dokument
Mit freundlichen Grüßen
Paule_VBA
Die Absatzmarken bekommst Du in Excel in die Zelle, indem Du  Alt festhältst und Enter drückst

Und hinter .Body = Cells(i, 3) fügst Du ein:

    'hier wird die Word-Datei angehängt
    .attachments.Add "D:\Privat\Meine_Datei.doc"

Ist doch auch ein Ansatz.