Hallo Thomas,
einmal einfach&geschmacklos ;)
Deinen E-Mail Client ??? - musste selber einsetzen - hier allgemein zu meinem Test eine CDO-Variante
LG
Option Explicit
Sub Versenden()
Dim strPath As String
Dim strFile As String
Dim strFull As String
Dim strBetr As String
Dim strAnhg As String
Dim StrEmpf As String
Dim strText As String
On Error GoTo errh
strPath = Sheets("Tabelle4").Range("K4").Value
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Sheets("Tabelle4").Range("K14").Value
If Right(strFile, 4) <> ".pdf" Then strFile = strFile & ".pdf"
strFull = strPath & strFile
'erzeugen
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Copy
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFull, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWindow.Close False
'versenden (neutral)
'ACHTUNG, dazu ist die Serveradresse deines Providers erforderlich
'hier in K16 eingetragen
'ACHTUNG, dazu ist eine Absenderadresse erforderlich
'hier in K18 eingetragen
strBetr = Sheets("Tabelle4").Range("K12").Value
strAnhg = strFull
StrEmpf = Sheets("Tabelle4").Range("K10").Value
strText = ""
CDO_Mail_Versand strBetr, strAnhg, StrEmpf, strText, _
Sheets("Tabelle4").Range("K16").Value, _
Sheets("Tabelle4").Range("K18").Value
On Error GoTo 0
errh:
If Err.Number = 0 Then MsgBox "Erfolgreich!"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub CDO_Mail_Versand(ByVal BETR As String, _
ByVal ANH As String, ByVal EMPF As String, ByVal MTEXT As String, _
ByVal ADDI As String, SENDER As String)
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
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") = ADDI
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
strbody = MTEXT
With iMsg
Set .Configuration = iConf
.To = EMPF
.CC = ""
.BCC = ""
.From = SENDER
.Subject = BETR
.TextBody = strbody
.AddAttachment ANH
.Send
End With
End Sub
|