Sehr geehrte Damen und Herren,
vorab möchte ich festhalten, dass ich bislang wenig Erfahrung mit Foren habe. Also sollte ich wichtige Angaben vergessen haben oder weitere Informationen benötigt werden, dann einfach bitte eine kurzen Post schreiben.
In den letzten Wochen habe ich ein VBA-Makro entwickelt, dass es mir ermöglicht "Serien-Mails" mit einer personalisierten Anrede zu versenden. Dafür werden die Anrede und der Nachname als Variable gesetzt und aus einer Excel-Liste ausgelesen.
Der "Body" der Mail wird aus einem HTML-Dokument erstellt, wobei dort die Anrede als Variable definiert ist.
Zusätzlich werden dann die Dateien angehangen und alle Mails (ca. 500 Adressen) automatisch seperat erstellt und verschickt.
(Wenn Sie das probieren, kann es sein, dass Sie eine Meldung erhalten, dass Sie über keine digitale Signatur verfügen, diese hatte ich auch, kann aber unter den Sicherheitseinstellungen geändert werden. Dann wird dieser Dialog nicht mehr angezeigt. Nach Rücksprache mit dem IBM-Helpdesk unbedenklich)
Nun kommt das Problem. Solange Empfänger innerhalb des Hauses (Kollegen) die Mail erhalten, ist alles perfekt und die Anhänge sind dabei.
Allerdings erhalten auch viele Externe (Kunden) diese Mail und dort passt zwar die Formatierung etc, aber es sind keine Anhänge dabei.
Ich habe keine Idee, wo der Fehler zu finden ist. Ich habe die Mail auch schon an meine private Mail-Adresse versandt (keine Filter, Firewall etc.) auch dort waren die Anhänge nicht dabei.
Leider bin ich kein Programmierer und den VBA-Code habe ich zu großen Teilen zusammen kopiert und dann angepasst.
Nun noch ein paar Angaben:
- Lotus Notes 8.5
- Office 2003
- Windows XP
Hier nun noch der VBA-Code:
Sub LotusMail(Empfaenger As String, Inhalt As String)
' Variablen
Const EMBED_ATTACHMENT = 1454
Dim server As String, mailfile As String
Dim session As Object
Dim db As Object
Dim doc As Object
Dim rtitem As Object
Dim EmbeddedObject As Object
' Auslesen der Mail-DB
Set session = CreateObject("Notes.NotesSession")
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set db = session.getdatabase(server, mailfile)
' E-Mail vorbereiten
Set doc = db.createdocument()
doc.Form = "Main Topic"
doc.SendTo = Empfaenger
doc.Subject = Cells(2, 5).Value
doc.principal = "Finanzinstitute@nordlb.de"
doc.viewicon = "75"
doc.FROM = session.UserName
' Inhalt
session.ConvertMIME = False ' Do not convert MIME to rich text
Set stream = session.CreateStream
Set body = doc.CreateMIMEEntity
Call stream.WriteText(Inhalt)
'ENC_IDENTITY_8BIT used because of technote found on notes.net
'
http://www-10.lotus.com/ldd/nd6forum.nsf/55c38d716d632d9b8525689b005ba1c0/aeedaf28e47546ad85256f6a000a4b48?OpenDocumentCall body.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT)
' ANHANG
Set rtitem = doc.CREATERICHTEXTITEM("ProjectDescription")
For Each Cell In Range("E8:E18")
If Cell = "" Then Exit For
Dateianhang = Cell.Value
Set EmbeddedObject = rtitem.EMBEDOBJECT(EMBED_ATTACHMENT, "", Dateianhang) 'Dateianhang mit Pfad und Dateiname überschreiben
Next
'SMTP-Originator
doc.PostedDate = Format$(Now, "dd.mm.yyyy") + " " + Format$(Now, "hh:nn:ss")
Call doc.Send(True, "")
'Aufräumarbeiten
Set doc = Nothing
Set db = Nothing
Set body = Nothing
Set stream = Nothing
session.ConvertMIME = True
End Sub
Sub Mail_senden()
'Für jede Zelle in Bereich d2 bis zur letzen belegten Zelle in Spalte d wird eine Mail versandt.
Dim emailText, Inhalt As String
Dim Cell As Range
emailText = dat_ReadText(Range("E5").Text)
For Each Cell In Range("d2:d" & Cells(Rows.Count, "d").End(xlUp).Row)
If Cell = "" Then Exit For
Inhalt = Replace(emailText, "__ANREDE__", Cell(1, -2) & " " & Cell(1, -1) & " " & Cell(1, 0) & ",")
Call LotusMail(Cell.Value, Inhalt)
Next
End Sub
Public Function dat_ReadText(DerPfad As String) As String
Dim sText As String, iFrei As Integer, i As Long
On Error GoTo Fehler
sText = ""
iFrei = FreeFile
Open DerPfad For Binary Access Read As #iFrei
i = LOF(iFrei)
sText = String(i, 0)
Get #iFrei, , sText
Close #iFrei
dat_ReadText = sText
Exit Function
Fehler:
MsgBox Err.Description
End Function
Kann der Fehler an unserer Firewall liegen, dass wir evtl. bei ausgehenden Mails die Anhänge entfernen?
Kann es der MIME-Konvertierung liegen? (hab ich mal in einem anderen Thread gelesen, aber ich habe keine Ahnung was das ist)
Ferne habe ich gelesen, dass auch Probleme mit Anhängen bei Internetmails geben kann. Könnte das hier der Fall sein?
Wo könnte der Fehler liegen?
Jede Hilfe ist willkommen und herzlichen Dank im Voraus.
Mit freundlichen Grüßen,
Christian
Thema: E-Mailversand mit Excel Makro - Problem mit Anhängen (Gelesen 27369 mal)