HTML-eMailversand
30.04.2008 14:32:00
volti
Ich möchte gerne meinem Kostenberichtsversand (email) von php auf Excel umstellen. (Politischer Grund)
Dazu habe ich mir schon eine kleine Routine geschrieben, die eine beliebige Anzahl (z.Zt. 60) emails erzeugt und inclusive der Kostenberichtsdatei versendet.
Hierbei habe ich noch zwei Probleme zu lösen, falls überhaupt möglich.
1. Werde ich bei jeder eMail mit einer lästigen, zu bestätigenden MsgBox "Eine Anwendung versucht...." behindert. Gibt es eine Möglichkeit, diese nicht oder nur einmalig bestätigen zu müssen?
Sicherlich ist das eine Spamverhinderungsfrage, aber doch in meinem Fall eher lästig.
2. Möchte ich in meinen Mails (HTML-Format) noch ein paar Icons einbauen. Die Möglichkeit diese per Link von einem Server zu laden, scheidet aus. Bleibt nur noch, diese irgendwie ins Mail an bestimmter Stelle einzufügen. Hat da jemand eine Ahnung wie man das machen kann.
Die Methode wie in php über <img src="cid:kb_hg.jpg" width="600" height="69" border="0"> wird wohl nicht gehen?!
viele Grüße aus Freigericht
Karl-Heinz
PS: Wenn's interessiert, hier meine bisheriger Ansatz:
Sub Versende_Berichte_per_Email()
'Working in 2000-2007
'This example send the last saved version of the Activeworkbook
Const olMailItem = 0
Const olFormatUnspecified = 0
Const olFormatPlain = 1
Const olFormatHTML = 2
Const olFormatRichText = 3
Const olImportanceLow = 0
ConstolmportanceNormal = 1 '(Default)
Const olImportanceHigh = 2
Dim OutApp As Object, OutMail As Object
Dim Zeile As Integer, Empf As Integer
Dim Pfad As String, Text As String
Pfad = "D:\PIV_ADD\Excel\"
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set Inp = Sheets("Vorgaben")
On Error Resume Next
Empf = 10
'HTML-Vorlage einlesen
Open "D:\PIV_ADD\Mailvorgabe.txt" For Binary As #1
Text = Input(LOF(1), #1)
Close #1
For Zeile = 3 To 100
If Inp.Cells(Zeile, Empf) = "" Then Exit For
Set OutMail = OutApp.CreateItem(0)
OutMail.To = Inp.Cells(Zeile, Empf + 1).Value
OutMail.CC = Inp.Cells(Zeile, Empf + 2).Value
OutMail.BCC = ""
OutMail.Subject = Inp.Cells(1, 12).Value
OutMail.Sendername = "Volti"
OutMail.BodyFormat = olFormatHTML
OutMail.Importance = olImportanceHigh
OutMail.Categories = "Kostenberichte"
If UCase$(Left$(Inp.Cells(Zeile, Empf), 4)) = "FRAU" Then
Anrede = "Sehr geehrte "
Else
Anrede = "Sehr geehrter "
End If
Anrede = Anrede & Inp.Cells(Zeile, Empf) & "," & vbCrLf & vbCrLf 'Anrede erstellen
Text = Replace(Text, "#Anrede#", Anrede) 'Anrede in Vorlagedaten _
_
ersetzen
Text = Replace(Text, "#Periode#", "Juli 2008")
OutMail.HTMLBody = Text
' OutMail.Body = Anrede & Inp.Cells(1, 14) 'restlichen Body zufü _
gen (Textformat)
For X = Empf + 3 To Empf + 10
If Inp.Cells(Zeile, X) = "" Then Exit For 'keine weiteren Anlagen _
_
mehr vorgegeben
OutMail.Attachments.Add Pfad & Inp.Cells(Zeile, X).Value 'Anlage beifügen
Next
OutMail.Send
' OutMail.Display
Next
On Error GoTo 0
Set Inp = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
End Sub