Excel Blatt als XLSX und PDF in Email verschicken

Sub Mail_Every_Worksheet() 'Working in Excel 2000-2016 'For Tips see: http://www. _ rondebruin.nl/win/winmail/Outlook/tips.htm Dim sh As Worksheet Dim wb As Workbook Dim FileExtStr As String Dim FileFormatNum As Long Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object TempFilePath = Environ$("temp") & "\" If Val(Application.Version)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Carsten,
probier mal.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Mail_Every_Worksheet()
'Working in Excel 2000-2016
'For Tips see: http://www. _
  rondebruin.nl/win/winmail/Outlook/tips.htm

Dim sh As Worksheet, wb As Workbook
Dim FileExtStr As String, FileFormatNum As Long, TempFilePath As String
Dim TempFileName As String, TempFilePDF As String, strSignatur As String
Dim strData As String, strTo As String
Dim OutApp As Object, OutMail As Object

TempFilePath = Environ$("temp") & "\"

If Val(Application.Version) < 12 Then
  'You use Excel 97-2003
  FileExtStr = ".xls": FileFormatNum = -4143
Else
  'You use Excel 2007-2016
  FileExtStr = ".xlsx": FileFormatNum = 51
End If

With Application
  .ScreenUpdating = False
  .EnableEvents = False
End With

Set OutApp = CreateObject("Outlook.Application")

For Each sh In ThisWorkbook.Worksheets
  If sh.Range("I1").Value Like "?*@?*.?*" Then
    
    sh.Copy
    Set wb = ActiveWorkbook
    
    With wb
      'Formeln durch Werte ersetzen
      .Sheets(1).Range("A1:V45") = .Sheets(1).Range("A1:V45").Value
      strData = .Sheets(1).Range("A44")
      strTo = Sheets(1).Range("I1")
      
      TempFileName = TempFilePath & .Sheets(1).Name & " " & Left(ThisWorkbook.Name, _
        InStrRev(ThisWorkbook.Name, ".") - 1) & FileExtStr
      
      TempFilePDF = Left(TempFileName, InStrRev(TempFileName, ".")) & "pdf"
      
      .Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePDF, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
      
      .SaveAs TempFileName, FileFormat:=FileFormatNum
      
      .Close True
    End With
    
    On Error Resume Next
    
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
      .to = strTo
      .CC = ""
      .BCC = ""
      .Subject = "Apothekenabverkaufsdaten " & strData
      .Body = "Liebe Kolleginnen und Kollegen," & Chr(10) & Chr(10) & _
        "anbei die aktuellen Apothekenabverkaufsdaten." & Chr(10) & _
        "Melden Sie sich bei Fragen gerne bei Ihrem RVL." & Chr(10) & Chr(10)
      .Attachments.Add TempFileName
      .Attachments.Add TempFilePDF
      'You can add other files also like this
      '.Attachments.Add ("C:\test.txt")
      'Mail nun Anzeigen - wichtig, damit 'GetInspector' funktioniert
      .Display
      'Cursor ans Ende der EMail setzen
      VBA.SendKeys "^{END}", True
      'Name der gespeicherten Signatur - bitte anpassen
      strSignatur = "2016_Bayer_Germany_Textonly"
      'Einfügen einer bestimmten Signatur
      .GetInspector.CommandBars.Item("Insert").Controls("Signatur").Controls(strSignatur).Execute
      .Send   'or use .Display
    End With
    
    On Error GoTo 0
    
    Set OutMail = Nothing
    
    Kill TempFileName
    Kill TempFilePDF
    
  End If
Next

With Application
  .ScreenUpdating = True
  .EnableEvents = True
End With

Set OutApp = Nothing
Set OutMail = Nothing
Set sh = Nothing
Set wb = Nothing
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Excel Blatt als XLSX und PDF in Email verschicken

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel Blatt als XLSX und PDF in Email verschicken

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread