Emailanhang via Excel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Servus Michel
Hier einmal der Code mit dem ich aus Excel via Outlook eine E-Mail versende:

Sub Schlosserei()
On Error Resume Next
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
'strhtml = Range("Q2").Value & " 

strhtml = strhtml & "Diese Email wurde automatisch erstellt, bitte nicht antworten! 

_
strhtml = strhtml & Range("V1").Value & " "
strhtml = strhtml & Range("V2").Value & "

" 'Pos
strhtml = strhtml & Range("W1").Value & " "
strhtml = strhtml & Range("W2").Value & "

" 'Datum
strhtml = strhtml & Range("X1").Value & " "
strhtml = strhtml & Range("X2").Value & "

" 'Wer
strhtml = strhtml & Range("Y1").Value & " "
strhtml = strhtml & Range("Y2").Value & "

" 'Was
strhtml = strhtml & Range("Z1").Value & " "
strhtml = strhtml & Range("Z2").Value & "

" 'Wo
strhtml = strhtml & Range("AA1").Value & " "
strhtml = strhtml & Range("AA2").Value & "

" 'Ebene
strhtml = strhtml & Range("AB1").Value & " "
strhtml = strhtml & Range("AB2").Value & "

" 'Ausstellung
strhtml = strhtml & Range("AC1").Value & " "
strhtml = strhtml & Range("AC2").Value & "

" 'Beschreibung
strhtml = strhtml & Range("AN1").Value & " "
strhtml = strhtml & Range("AN2").Value & "

" 'Foto
strhtml = strhtml & Range("AF1").Value & " "
strhtml = strhtml & Range("AF2").Value & "

" 'übernommen von
strhtml = strhtml & Range("AG1").Value & " "
strhtml = strhtml & Range("AG2").Value & "

" 'Status
.to = Worksheets("Matrix").Range("N10")                          'Anpassen!!!!!!!!!!!!
'.cc = Range("AB2")
.Subject = "Neuer Eintrag in der Mängelliste"
.htmlbody = strhtml
.display 'Zeigt die Mail an
'.send 'Optional Mail sofort senden.
End With
Set olApp = Nothing
End Sub

Leider bin ich was VBA betrifft nicht allzu bewandert. Lediglich Makrorecorder bzw. einige Makro Schnipsel. Vielleicht kannst du mir trotzdem behilflich sein.
LG Helmut

...meinerseits Helmut,
wenn Dir das nicht weiterhilft bin ich aus diesem Faden raus, dann muss jemand anderes helfen.
Nach wie vor ist die entscheidende Zeile/Funktion die Du brauchst diese hier:

.Attachements.Add PFAD & Cells(2, "V") & ".jpg"

Damit fügst Du eine Datei als Anlage Deiner generierten Email hinzu. Die gezeigte Methode verlangt nach einem vollständigen Dateipfad für die anzufügende Datei - diesen Pfad musst Du also entsprechend zusammensetzen. Im Code nimmst Du dafür den fixen Teil des Speicherorts/Verzeichnisses (= PFAD) und fügst dann noch den Dateinamen und die Dateiendung hinzu.
Wenn also das Mangelfoto Nr. 2 diesen Dateipfad aufweist "C:\Users\helmu\Pictures\Camera Roll\2.jpg", dann muss die o.a. Methode schematisch so aussehen...

.Attachements.Add PFAD & "2" & ".jpg"

(weil Du den PFAD-Teil ja als Konstante bereits im Code definiert hast). Wenn Du also diesen "2"er nicht hart im Code festschreiben willst (weil Du ja hier "dynamisch" bleiben willst) dann musst Du stattdessen die Zelladresse angeben, in der diese "2" zu finden ist; bspw. mit Range("B3") oder was auch immer.
LG
Michael

Sub Schlosserei() Const PRE$ = "Diese Email wurde automatisch erstellt, bitte nicht antworten!" Const PFAD$ = "C:\DeinVerzeichnis\DeinOrdnerMitBildern\" Dim olApp As Object, olMail As Object Dim strHTML$, i&, j& Set olApp = CreateObject("Outlook.Application") Set olMail = olApp.CreateItem(0) 'strhtml = Range("Q2").Value & " " 'Werte aus Spalten V:AC in strHTML übernehmen For i = 22 To 29 'Spalten V bis AC For j = 1 To 2 'Zeilen 1:2 der jeweiligen Spalte 'bei Werten aus Zeile 2 wird hinten "" angefügt, bei Zeile 1 " " strHTML = strHTML & Cells(j, i).Value & IIf(j = 2, "", " ") Next j 'nächste Zeile Next i 'nächste Spalte 'Werte aus AN1:AN2 in strHTML übernehmen strHTML = strHTML & Cells(40, 1).Value & " " strHTML = strHTML & Cells(40, 2).Value & "" 'Werte aus AF1:AF2 in strHTML übernehmen strHTML = strHTML & Cells(32, 1).Value & " " strHTML = strHTML & Cells(32, 2).Value & "" 'Werte aus AG1:AG2 in strHTML übernehmen strHTML = strHTML & Cells(33, 1).Value & " " strHTML = strHTML & Cells(33, 2).Value & "" With olMail 'Status .To = Worksheets("Matrix").Range("N10") '.cc = Range("AB2") .Subject = "Neuer Eintrag in der Mängelliste" .htmlbody = strHTML If Range("V2") "" Then .Attachments.Add PFAD & Range("V2").Text & ".jpg" End If .display 'Zeigt die Mail an '.send 'Optional Mail sofort senden. End With Set olApp = Nothing Set olMail = Nothing End Sub

' Email erstellen Set olApp = CreateObject("Outlook.Application") With olApp.CreateItem(0) .GetInspector.Display olOldBody = .htmlBody .To = strAddress .Subject = FileName ' Betreff .htmlBody = "Liebe Sportfreunde, " & _ "anbei findet Ihr die aktuelle Liste zum Rundenwettkampf. " & _ WettkampfLiga & " " & _ "Mit Schützengruß " & _ User & _ " Rundenwettkampfleiter" & _ " Mail: " & _ FromMail & _ " " & _ olOldBody .Attachments.Add FullFileName 'Datei anhängen End With

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

123 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Emailanhang via Excel

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

123 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread