|
Hallo zusammen,
folgendes Problem: ich habe ein Makro aufgesetzt durch welches automatisiert eine Mail verschickt werden soll. In Spalte B ist die Anrede in Spalte C der Empfänger, in D cc, in E der Betreff. Danach folgen die Anlagen. Mein Problem besteht nun im folgenden: zum einen möchte ich mehrere Spalten bei den Anlagen mitaufnehmen (bis Spalte Z) und falls Spalten leer sind, es also keine Anlagen gibt, soll die Mail trotzdem eben versendet werden. Hier mein Makro:
Sub Mails_SendenLtList()
'Sub sendet Mails lt. Liste
'Anlagen kommagetrennt oder per Zeilenumbruch CHR(10)
'Mit oder ohne Pfadangabe
Dim WSh As Worksheet, sDatei() As String, sTxt As String
Dim sPfad As String, sMailtext As String, sSig As String
Dim iZeile As Long, i As Long
Dim oMail As Object, sAnl As String
Set WSh = Worksheets("Tabelle1") 'Mail-Blatt festlegen
With CreateObject("Outlook.Application")
For iZeile = 2 To WSh.UsedRange.Rows.Count 'Liste der Mails durchgehen
If WSh.Cells(iZeile, "C").Value <> "" Then 'Mindestens Mail-Adresse muss ausgefüllt sein
Set oMail = .CreateItem(0) 'Mail kreieren
With oMail
.Getinspector: sSig = .htmlbody 'Signatur holen
.To = WSh.Cells(iZeile, "C").Value 'Adresse
.cc = WSh.Cells(iZeile, "D").Value 'Kopieempfänger
.Subject = WSh.Cells(iZeile, "E").Value 'Betreffzeile
sMailtext = "<span style='font-size:13pt;font-family:Arial;color:#000000;'>" _
& WSh.Cells(iZeile, "B").Value & "<br><br>" _
& "anbei senden wir Ihnen den unterzeichneten Dienstleistungsrahmenvertrag.<br><br>" _
& "Bei Fragen melden Sie sich gerne bei uns.<br>" _
& "</span>"
sAnl = WSh.Cells(iZeile, "F").Value & "," _
& WSh.Cells(iZeile, "G").Value 'Anlage(n) mit/ohne Pfad
If sAnl <> "" Then 'Anlagen anfügen
sDatei = Split(Replace(sAnl, vbLf, ","), ",")
For i = 0 To UBound(sDatei)
If InStr(sDatei(i), ":") = 0 Then
sDatei(i) = sPfad & sDatei(i) 'Pfad vorsetzen
End If
If Dir(sDatei(i)) <> "" Then 'Anlage(n) anfügen
.attachments.Add sDatei(i)
End If
Next i
End If
.htmlbody = Replace(sMailtext, "~", "") & sSig 'Body-Text, Signatur einfügen
.send
End With
Set oMail = Nothing 'Objekt-Variable zurücksetzen
WSh.Cells(iZeile, "I").Value = "Gesendet" 'Als gesendet markieren
End If
Next iZeile
End With
End Sub
Danke!
|