|  
                                             
	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
	  
     |