Wie füge ich der Mail einen Text hinzu?
Hallo,
ich versende mit dem Unten stehenden Code E-Mails aus Excel 2010. Soweit läuft auch alles wunderbar. Nun möchte ich noch einen Text in die Mail einfügen. Wie muß ich vorgehen? Wenn ich Body = "Blabla" einfüge bekomme ich einen Fehler.
Gruß Asterix2
Dim Epfänger As String
Dim arrTo As Variant
arrTo = Array(Range("A83").Value, Range("A1").Value, Range("A2").Value, Range("A3").Value, Range("A4").Value, Range("A5").Value)
ActiveWorkbook.SendMail Recipients:=arrTo, Subject:="Ich bin eine Mail" & "_" & strFile
Dim arrTo As Variant
arrTo = Array(Range("A83").Value, Range("A1").Value, Range("A2").Value, Range("A3").Value, Range("A4").Value, Range("A5").Value)
ActiveWorkbook.SendMail Recipients:=arrTo, Subject:="Ich bin eine Mail" & "_" & strFile
Please also mark the comments that contributed to the solution of the article
Content-Key: 196829
Url: https://administrator.de/contentid/196829
Printed on: May 2, 2024 at 22:05 o'clock
8 Comments
Latest comment
Moin!
Ich glaub, das geht so nicht.
Es gibt aber andere Lösungen um Mails via Script zu senden.
Schau mal hier:
http://www.rondebruin.nl/sendmail.htm
Gruß Napperman
Ich glaub, das geht so nicht.
Es gibt aber andere Lösungen um Mails via Script zu senden.
Schau mal hier:
http://www.rondebruin.nl/sendmail.htm
Gruß Napperman
Hallo Asterix2!
Wenn's vollautomatisiert ablaufen soll, dann gibt es noch ne andere Möglichkeit, allerdings sind dann noch weitere Parameter erforderlich:
1. Die EMail-Adresse des Absender
2. Der Smtp-Server (z.B. "smtp.1und1.de")
3. Das Passwort
4. SSL-Verschlüsselung
5. Smtp-Port
Zu 1. Als Konstante oder die Möglichkeit, diese anhand des Workbook-Inhalts auszulesen
Zu 2. Als Konstante
Zu 3. Vorzugsweise eine verdeckte Passwort-Abfrage mittels einer kleinen UserForm
Zu 4. Als Konstante (True/False)
Zu 5. Als Konstante oder Standard-Ports anhand von SSL-Status (True/False) ermitteln: Ohne SSL Port 25, Mit SSL Port 465)
Zudem wäre noch interessant zu wissen, ob die Empfänger-Adressen in den Zellen A1, A2, ... als Hyperlinks angezeigt werden?
Gruß Dieter
[edit] Funktioniert mit meiner Idee leider nicht, weil keine Datei angehängt werden kann, die geöffnet ist. Allerdings besteht die Möglichkeit eine Copy der aktiven Arbeitsmappe zu speichern und diese zu versenden [/edit]
Wenn's vollautomatisiert ablaufen soll, dann gibt es noch ne andere Möglichkeit, allerdings sind dann noch weitere Parameter erforderlich:
1. Die EMail-Adresse des Absender
2. Der Smtp-Server (z.B. "smtp.1und1.de")
3. Das Passwort
4. SSL-Verschlüsselung
5. Smtp-Port
Zu 1. Als Konstante oder die Möglichkeit, diese anhand des Workbook-Inhalts auszulesen
Zu 2. Als Konstante
Zu 3. Vorzugsweise eine verdeckte Passwort-Abfrage mittels einer kleinen UserForm
Zu 4. Als Konstante (True/False)
Zu 5. Als Konstante oder Standard-Ports anhand von SSL-Status (True/False) ermitteln: Ohne SSL Port 25, Mit SSL Port 465)
Zudem wäre noch interessant zu wissen, ob die Empfänger-Adressen in den Zellen A1, A2, ... als Hyperlinks angezeigt werden?
Gruß Dieter
[edit] Funktioniert mit meiner Idee leider nicht, weil keine Datei angehängt werden kann, die geöffnet ist. Allerdings besteht die Möglichkeit eine Copy der aktiven Arbeitsmappe zu speichern und diese zu versenden [/edit]
Hallo Asterix2!
Gruß Dieter
Die Datei sollte schon angehängt werden. Alles andere wäre schlecht.
Habe doch geschrieben, dass es mit einer Kopie geht. Das bedeutet, dass im Code eine aktuelle Kopie per ThisWorkbook.CopySaveAs im Temp-Ordner gespeichert und verschickt werden kann.Gruß Dieter
Hallo Asterix2!
Schritt 1:
- Erstelle eine UserForm mit Namen 'FrmPW' und füge eine TextBox mit Namen 'InputPW' und einen OK-Button mit Namen 'cBtnOK' ein.
- Füge in der UserForm diesen Code ein:
Schritt 2:
- Füge diesen Code in das betreffende Tabellenblatt ein:
Die Konstanten 'cdoFromAddress', 'cdoSmtpServer' und 'cdoSSL' anpassen
Gruß Dieter
Schritt 1:
- Erstelle eine UserForm mit Namen 'FrmPW' und füge eine TextBox mit Namen 'InputPW' und einen OK-Button mit Namen 'cBtnOK' ein.
- Füge in der UserForm diesen Code ein:
Option Explicit
Function GetPassword() As String
Show
GetPassword = InputPW.Text
Unload Me
End Function
Private Sub InputPW_AfterUpdate()
Hide
End Sub
Private Sub cBtnOK_Click()
Hide
End Sub
Schritt 2:
- Füge diesen Code in das betreffende Tabellenblatt ein:
Option Explicit
Private Const cdoFromAddress = "Deine Email-Adresse" 'Mail-Adresse-Von (Anpassen)
Private Const cdoSmtpServer = "Smtp-Server-Adresse" 'Mail-Adresse-Smtp-Server (Anpassen)
Private Const cdoBase64 = 1 'Mail-Kodierung
Private Const cdoSendUsing = 2 'Mail-Senden
Private Const cdoSSL = False 'Mail-SSL-Verschlüsselung True/False (Anpassen)
Private Const cdoSmtpPort = 25 'Mail-Smtp-Port ohne SSL
Private Const cdoSmtpPortSSL = 465 'Mail-Smtp-Port mit SSL
Private Const cdoTimeout = 60 'Mail-Timeout
Private Const cdoConfig = "http://schemas.microsoft.com/cdo/configuration/"
Private Const ErrMsg1 = "Keine EMail-Adressen gefunden" 'Fehlermeldung
Private Const ErrMsg2 = "Kein Password angegeben!" 'Fehlermeldung
Private Const ErrMsg3 = "Anhang nicht gefunden:" 'Fehlermeldung
Private Const ErrMsg4 = "EMail-Versand fehlgeschlagen: " 'Fehlermeldung
Sub SendMails() 'Diese Zeile durch die Button-Sub im Tabellenblatt ersetzen
Dim objHyperlink As Hyperlink, strPassword As String, strToAddress As String
Dim strSubject As String, strText As String, strAttachment As String, x
strPassword = FrmPW.GetPassword
If strPassword = "" Then
MsgBox ErrMsg2, vbExclamation, "Fehler..."
Else
With Columns("A:A")
If .Hyperlinks.Count Then
strSubject = "Der Betreff"
strText = "Der Text"
strAttachment = Environ("Temp") & "\" & ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs strAttachment
For Each objHyperlink In .Hyperlinks
If InStr(objHyperlink.Address, "mailto:") > 0 Then
Call SendCdoMail(strPassword, objHyperlink.Name, strSubject, strText, strAttachment)
End If
Next
Kill strAttachment
MsgBox "Habe Fertig!", vbInformation, "EMail-Versand..."
Else
MsgBox ErrMsg1, vbExclamation, "Fehler..."
End If
End With
End If
End Sub
Private Sub SendCdoMail(ByRef strPassword, ByRef strToAddress, ByRef strSubject, _
ByRef strText As String, ByRef strAttachment)
With CreateObject("CDO.Message")
.From = cdoFromAddress
.To = strToAddress
.Subject = strSubject
.TextBody = strText
If Dir(strAttachment) <> "" Then
.AddAttachment strAttachment
Else
MsgBox ErrMsg3, vbExclamation, "Fehler...": Exit Sub
End If
With .Configuration.Fields
.Item(cdoConfig & "sendusing") = cdoSendUsing
'Smtp-Server Name oder IP
.Item(cdoConfig & "smtpserver") = cdoSmtpServer
'Smtp-Server SSL (True/False)
.Item(cdoConfig & "smtpusessl") = cdoSSL
'Smtp-Server Port (mit SSL 465/ohne SSL 25)
.Item(cdoConfig & "smtpserverport") = IIf(cdoSSL, 465, 25)
'Format-Type Base64 Encoded
.Item(cdoConfig & "smtpauthenticate") = cdoBase64
'Smtp-Server Benutzer ID
.Item(cdoConfig & "sendusername") = cdoFromAddress
'Smtp-Server Passwort
.Item(cdoConfig & "sendpassword") = strPassword
'Smtp-Server Timeout)
.Item(cdoConfig & "smtpconnectiontimeout") = cdoTimeout
.Update
End With
On Error Resume Next
.Send
If Err.Number Then MsgBox ErrMsg4 & strToAddress, vbExclamation, "Fehler..."
On Error GoTo 0
End With
End Sub
Gruß Dieter