Mail automatisch versenden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tom,
grundsätzlich ist das möglich und es gibt auch verschiedene Möglichkeiten, das einzufügen.
Man kann einen ganzen Zellbereich original oder als Bild einfügen oder auch eben nur ein Bild einfügen.
Deinen Code habe ich mir nur oberflächlich angesehen und auch so gelassen....
Im ersten Makro habe ich mal mit der WordEditor-Methode a) eine Zell-Kopiermöglichkeit und b) eine NurBild-Kopiermöglichkeit reingesetzt.
Entscheide selbst, was besser ist und remme den jeweiligen anderen Code aus.
Nachfolgend findest Du einen Beispielcode. Vielleicht gefällt es Dir ja.

Sub Eine_Datei()

    Dim OutApp As Object, Mail As Object

    Dim Nachricht

    Dim lngAnz As Long, i As Long

    Dim sMailtext As String

    lngAnz = Application.InputBox("Empfänger von Zeile 4  bis ...", "Anzahl der Mails", , , , , , 1)

    For i = 4 To lngAnz 'Anzahl der Mails

    'Variablen müssen bei jeder Schleife neu initalisiert werden

        Set OutApp = CreateObject("Outlook.Application")

        Set Nachricht = OutApp.CreateItem(0)

        With Nachricht

            .To = Cells(i, 1) 'Adresse

            .Subject = Cells(i, 2) 'Betreffzeile

             .OriginatorDeliveryReportRequested = True ' übermittlungsbestätigung

            .ReadReceiptRequested = True ' Lesebestätigung

            .attachments.Add Trim(Cells(i, 8).Text)

            sMailtext = Cells(i, 3) & Chr$(10) & Chr$(10) & Cells(i, 4) & Chr$(10) & Chr$(10) & Cells(i, 5) & Chr$(10) _

                      & Chr$(10) & Cells(i, 6) & Chr$(10) & Chr$(10)

            .Body = sMailtext & Trim$(Cells(i, 7)) 'Sendetext

            'Hier wird die Mail gleich in den Postausgang gelegt

            'und die Sicherheitsabfrage muss jedesmall bestätigt werden

            '.Send

            'Hier wird die Mail "angezeigt"

            'aber gleich versendet,... OHNE Sicherheitsabrage

            .Display

             With .Getinspector.WordEditor.Application.Selection

'Entweder einen Bereich kopieren, hier nur eine Zelle

 Rem              ThisWorkbook.Worksheets("Mail").Cells(i, "G").Copy

'Oder nur die Grafik

               ThisWorkbook.Worksheets("Mail").Shapes.Range(Array("Picture 4")).Select

               Selection.Copy

'bis hier, eins von beiden ausremmen

               .Start = Len(sMailtext)

               .End = Len(sMailtext)

               .Paste

             End With

             SendKeys "%s", True

        End With

        'Variablen zurücksetzen sonst geht es nicht

        Set OutApp = Nothing 'CreateObject("Outlook.Application")

        Set Nachricht = Nothing 'OutApp.CreateItem(0)

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

    Next i

End Sub

viele Grüße
Karl-Heinz

Hallo Tom,
danke für die Rückmeldung. Du hast keine Fehlermeldung eingefügt, sondern die gelb markierte Zeile, wo das Programm gerade steht. Aber nicht schlimm.
Der Dateiname, der aus Spalte $H stammend angehängt werden soll, ist fehlerhaft. Wir sind hier nicht im HTML oder DOS unterwegs, so dass dieser Pfad "..\Dropbox\IMG_4305.PNG.jpg" schon vollständig sein muss und nicht einleitend mit Platzhalter .. funktioniert. Im u.a. Code habe ich deshalb einen Fehlerabfang reingebaut.
Das ist eine Bilddatei. Falls Du vorhast, die einzubettende Grafik als Datei mitzuschicken, sage ich Dir hiermit, dass das nicht nötig ist...
Außerdem hast Du den wichtigsten Codeteil zum Einfügen der Grafik überhaupt nicht eingebaut. S. u. Code...
Noch etwas. Der Code fügt aktuell immer die Grafik 4 ein. Wenn Du je Zeile eine andere Grafik nehmen willst, müssen wir das noch etwas abändern.
https://www.herber.de/bbs/user/136872.xlsm

Sub Eine_Datei()

    Dim OutApp As Object, Mail As Object

    Dim Nachricht

    Dim lngAnz As Long, i As Long

    Dim sMailtext As String

    lngAnz = Application.InputBox("Empfänger von Zeile 4  bis ...", "Anzahl der Mails", , , , , , 1)

    For i = 4 To lngAnz 'Anzahl der Mails

    'Variablen müssen bei jeder Schleife neu initalisiert werden

        Set OutApp = CreateObject("Outlook.Application")

        Set Nachricht = OutApp.CreateItem(0)

        With Nachricht

            .To = Cells(i, 1) 'Adresse

            .Subject = Cells(i, 2) 'Betreffzeile

             .OriginatorDeliveryReportRequested = True ' übermittlungsbestätigung

            .ReadReceiptRequested = True ' Lesebestätigung

            If Dir$(Trim(Cells(i, 8).Text)) &LT;&GT; "" Then

              .attachments.Add Trim(Cells(i, 8).Text)

            End If

            sMailtext = Cells(i, 3) & Chr$(10) & Chr$(10) & Cells(i, 4) & Chr$(10) & Chr$(10) & Cells(i, 5) & Chr$(10) _

                      & Chr$(10) & Cells(i, 6) & Chr$(10) & Chr$(10)

            .Body = sMailtext & Trim$(Cells(i, 7)) 'Sendetext

            'Hier wird die Mail gleich in den Postausgang gelegt

            'und die Sicherheitsabfrage muss jedesmall bestätigt werden

            '.Send

            'Hier wird die Mail "angezeigt"

            'aber gleich versendet,... OHNE Sicherheitsabrage

            .Display

             With .Getinspector.WordEditor.Application.Selection

'Entweder einen Bereich kopieren, hier nur eine Zelle

 Rem              ThisWorkbook.Worksheets("Mail").Cells(i, "G").Copy

               ThisWorkbook.Worksheets("Mail").Shapes.Range(Array("Picture 4")).Select

               Selection.Copy

               .Start = Len(sMailtext)

               .End = Len(sMailtext)

               .Paste

             End With

 '            SendKeys "%s", True

        End With

        'Variablen zurücksetzen sonst geht es nicht

        Set OutApp = Nothing 'CreateObject("Outlook.Application")

        Set Nachricht = Nothing 'OutApp.CreateItem(0)

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

    Next i

End Sub

viele Grüße
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

208 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mail automatisch versenden

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

208 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread