Mailversand mit SMTP

Sub Mail_schicken() 'Variablendeklaration für Mailversand Dim iMsg As Object Dim iConf As Object Dim Flds As Variant Dim Mailbetreff As String Dim Mailinhalt As String Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") iConf.Load -1 'CDO Source Defaults Set Flds = iConf.Fields With Flds .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "172.25.8.104" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 .Update End With On Error Resume Next With iMsg Set .Configuration = iConf .To = "werner.bruhn@benteler.com" '.CC = "" '.BCC = "" .From = "werner.bruhn@benteler.com" .Subject = "Mailbetreff" .TextBody = "Mailtext" .Send End With If Err.Number 0 Then MsgBox Err.Description, _ vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _ "Error: " & Err.Number, Err.HelpFile, Err.HelpContext End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Function fncRangeToHtml(strWorksheetname As String, _ strRangeaddress As String) As String Dim objFilesytem As Object, objTextstream As Object Dim strFilename As String strFilename = Environ$("temp") & "/" & _ Format(Now, "dd-mm-yy h-mm-ss") & ".htm" ActiveWorkbook.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=strFilename, _ Sheet:=strWorksheetname, _ Source:=strRangeaddress, _ HtmlType:=xlHtmlStatic).Publish True Set objFilesytem = CreateObject("Scripting.FileSystemObject") Set objTextstream = objFilesytem.GetFile(strFilename). _ OpenAsTextStream(1, -2) fncRangeToHtml = objTextstream.ReadAll objTextstream.Close Set objTextstream = Nothing Set objFilesytem = Nothing Kill strFilename End Function

With iMsg Set .Configuration = iConf .To = "werner.bruhn@benteler.com" '.CC = "" '.BCC = "" .From = "werner.bruhn@benteler.com" .Subject = "Mailbetreff" .TextBody = fncRangeToHtml("Blattname", "A1:C10") .Send End With

Hallo Raphael,
Blattname hatte ich geändert. Habe Textbody ersetzt, die Fehlermeldung ist die gleiche.
noch mal der gesamte Code:
Sub Mail_schicken()
'Variablendeklaration für Mailversand
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Dim Mailbetreff As String
Dim Mailinhalt As String
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 'CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "172.25.8.104"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With
On Error Resume Next
With iMsg
Set .Configuration = iConf
.To = "werner.bruhn@benteler.com"
'.CC = ""
'.BCC = ""
.From = "werner.bruhn@benteler.com"
.Subject = "Mailbetreff"
.HtmlBody = fncRangeToHtml("Abholung", "A1:R24")
.Send
End With
If Err.Number 0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub

Private Function fncRangeToHtml(strWorksheetname As String, _
strRangeaddress As String) As String
Dim objFilesytem As Object, objTextstream As Object
Dim strFilename As String
strFilename = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
filename:=strFilename, _
Sheet:=strWorksheetname, _
Source:=strRangeaddress, _
HtmlType:=xlHtmlStatic).Publish True
Set objFilesytem = CreateObject("Scripting.FileSystemObject")
Set objTextstream = objFilesytem.GetFile(strFilename). _
OpenAsTextStream(1, -2)
fncRangeToHtml = objTextstream.ReadAll
objTextstream.Close
Set objTextstream = Nothing
Set objFilesytem = Nothing
Kill strFilename
End Function

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread