Hallo zusammen,
ich habe folgenden Frage:
Ist es möglich Anhand einer Liste (in Excel) in der mehrere unterschiedliche Dateinamen stehen, nach diesen Dateien in einem vorher definierten Orderpfad zu suchen und als Anhang in eine Mail zu packen?
Perfekt wäre es auch, wenn das Makro zusätzlich noch diese oben erwähnte Liste einfach als Tabelle im Mailtext reinkopiert wird.
Danke für eure Hilfe.
PS: Im Anhang eine Datei, die diese Liste zeigt. Der Dateiname setzt sich aus Spalte A und Spalte B zusammen.
Hallo,
ja, alles ist möglich.
Nachfolgend ein Beispiel als Anregung. Aufgrund Deiner spärlichen Angaben müsstest Du ggf. noch manches anpassen.
Code:
Option Explicit
Option Compare Text
Sub Mail_BereichalsBild_Word()
'Sendet Mail mit integriertem Bereich als Bild mit Signatur
'Das Bild wird über das Kürzel ~ im Text platziert
Dim WSh As Worksheet, WkS As Worksheet
Dim sMailtext As String, sBild As String, sSignatur As String
Dim sBer As String, iEinf As Integer
Dim sPfad As String, oZelle As Range
sPfad = ThisWorkbook.Path & "\" 'ggf. anpassen
sBer = "A3:C21" 'Kopierbereich
Set WSh = ThisWorkbook.Sheets("Tabelle1") 'Blatt mit Maildaten
Set WkS = ThisWorkbook.Sheets("Tabelle2") 'Datenblatt
On Error Resume Next
Do
WkS.Range(sBer).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
If Err.Number = 0 Then Exit Do
Err.Clear
Loop
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 'HTML-Format, Angabe optional
.Subject = WSh.Range("A2").Value 'Betreff
.To = WSh.Range("A3").Value 'Empfänger
.cc = WSh.Range("A4").Value 'Kopie
sMailtext = WSh.Range("A5").Value & vbLf
.Getinspector: sSignatur = .htmlbody 'Signatur holen
.htmlbody = Replace(sMailtext, vbLf, "<br>") & sSignatur
.Display
iEinf = Len(sMailtext) 'Grafik Einfügestelle
With .Getinspector.WordEditor.Application.Selection
.Start = iEinf: .End = iEinf
.Paste 'Grafik in Mail einfügen
End With
'Anlagen dran
For Each oZelle In Range("A1:A5") 'Dateienbereich anpassen
If Dir$(sPfad & oZelle.Value) <> "" Then
.attachments.Add sPfad & "\" & oZelle.Value
End If
Next oZelle
End With
End Sub
______________________
viele Grüße aus Freigericht
Karl-Heinz
Hallöchen,
bitte poste Deine Excel-Fragen im Excel-Forum und nicht im Beispielbereich. Ich habe das Thema gerade nach Excel verschoben ...
Wow, der Code von volti ist fast perfekt.
Ich habe diesen ein kleines bisschen angepasst wie ich es brauche und es funktioniert sehr gut.
Eine Sache würde ich aber gerne noch haben:
Das Makro fügt den Bereich als Bild in meine Mail hinzu.
Wie muss ich den Code ändern, damit das Makro den Bereich als Text hinzufügt?
Aber auf jeden Fall schon mal vielen Dank!
Hallo, was meinst Du mit Text.
Hier mal eine Abweichung, die den Bereich als Bereich einfügt.
Wenn Du wirklich Text haben möchtest, müsste man den Bereich pro Zelle durchscannen und den Wert ins Mail übernehmen.
Code:
Option Explicit
Option Compare Text
Sub Mail_BereichalsBereich_Word()
'Sendet Mail mit integriertem Bereich als Bild mit Signatur
'Das Bild wird über das Kürzel ~ im Text platziert
Dim WSh As Worksheet, WkS As Worksheet
Dim sMailtext As String, sBild As String, sSignatur As String
Dim sBer As String, iEinf As Integer
Dim sPfad As String, oZelle As Range
sPfad = ThisWorkbook.Path & "\" 'ggf. anpassen
sBer = "A3:C21" 'Kopierbereich
Set WSh = ThisWorkbook.Sheets("Tabelle1") 'Blatt mit Maildaten
Set WkS = ThisWorkbook.Sheets("Tabelle2") 'Datenblatt
On Error Resume Next
Do
WkS.Range(sBer).Copy 'Bereich kopieren
If Err.Number = 0 Then Exit Do
Err.Clear
Loop
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 'HTML-Format, Angabe optional
.Subject = WSh.Range("A2").Value 'Betreff
.To = WSh.Range("A3").Value 'Empfänger
.cc = WSh.Range("A4").Value 'Kopie
sMailtext = WSh.Range("A5").Value & vbLf
.Getinspector: sSignatur = .htmlbody 'Signatur holen
.htmlbody = Replace(sMailtext, vbLf, "<br>") & sSignatur
.Display
iEinf = Len(sMailtext) 'Grafik Einfügestelle
With .Getinspector.WordEditor.Application.Selection
.Start = iEinf: .End = iEinf
.Paste 'Grafik in Mail einfügen
End With
'Anlagen dran
For Each oZelle In Range("A1:A5") 'Dateienbereich anpassen
If Dir$(sPfad & oZelle.Value) <> "" Then
.attachments.Add sPfad & "\" & oZelle.Value
End If
Next oZelle
End With
End Sub
______________________
viele Grüße aus Freigericht
Karl-Heinz
Perfekt!
Genau das meinte ich.
Vielen dank dir.