[VBA] Email mit bestimmten Dateianhängen erstellen

[DeLaGhetto]

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.

[volti]

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

[schauan]

Hallöchen,

bitte poste Deine Excel-Fragen im Excel-Forum und nicht im Beispielbereich. Ich habe das Thema gerade nach Excel verschoben ...

[DeLaGhetto]

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!

[volti]

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

[DeLaGhetto]

Perfekt!

Genau das meinte ich.

Vielen dank dir.