Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

[VBA] Email mit bestimmten Dateianhängen erstellen
#1
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.


Angehängte Dateien
.xlsx   Mappe1.xlsx (Größe: 10,18 KB / Downloads: 2)
Antwortento top
#2
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
[-] Folgende(r) 1 Benutzer sagt Danke an volti für diesen Beitrag:
  • DeLaGhetto
Antwortento top
#3
Hallöchen,

bitte poste Deine Excel-Fragen im Excel-Forum und nicht im Beispielbereich. Ich habe das Thema gerade nach Excel verschoben ...
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#4
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!
Antwortento top
#5
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
[-] Folgende(r) 1 Benutzer sagt Danke an volti für diesen Beitrag:
  • DeLaGhetto
Antwortento top
#6
Perfekt!

Genau das meinte ich.

Vielen dank dir.
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste