Excel als PDF > XLSX > Email angang

Private Sub CommandButton1_Click() ChDir "C:\Users\asafarr1\Desktop\Testordner\" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Range("F5").Value & Format(Date, "Test YYYYMMDD") & ".pdf", Quality:=xlQualityStandard, _ _ _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton1_Click() Dim FName As String ChDir "C:\Users\asafarr1\Desktop\Testordner\" FName = Range("F5").Value & Format(Date, "Test YYYYMMDD") & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FName, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 'als Email versenden Application.DisplayAlerts = False Dim Email As Object, OutApp As Object Dim AWS As String, strOldBody As String Dim InitializeOutlook Set xRg = Sheets("Sheet1").Range("A1:C" & a) Set OutApp = CreateObject("Outlook.Application") AWS = "C:\Users\asafarr1\Desktop\Testordner\" & FName InitializeOutlook = True Set Email = OutApp.CreateItem(0) With Email .GetInspector strOldBody = .HTMLBody .To = "vonmir@zudir.com" 'email Adresse eintragen '.CC = "" 'hier eventuelle Kopie Empfaenger .Subject = FName .Attachments.Add AWS .HTMLBody = "Dein Text" & strOldBody 'hier deinen Text eingeben, das & strOldBody _ ist dazu da um deine Signatur wieder einzufuegen '.Send 'gleich senden .Display 'erst anzeigen End With Set OutApp = Nothing Set Email = Nothing Application.DisplayAlerts = True End Sub

Private Sub CommandButton1_Click() Dim FName As String, FPath As String, strOldBody As String Dim Email As Object, OutApp As Object Dim InitializeOutlook FPath = "C:\Users\asafarr1\Desktop\Testordner\" FName = Range("F5").Value & "Test" & Format(Date, "YYYYMMDD") & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FPath & FName, Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 'als Email versenden Application.DisplayAlerts = False Set OutApp = CreateObject("Outlook.Application") InitializeOutlook = True Set Email = OutApp.CreateItem(0) With Email .GetInspector strOldBody = .HTMLBody .To = "vonmir@zudir.com" 'email Adresse eintragen '.CC = "" 'hier eventuelle Kopie Empfaenger .Subject = FName .Attachments.Add FPath & FName .HTMLBody = "Dein Text" & strOldBody 'hier deinen Text eingeben, das & strOldBody _ ist dazu da um deine Signatur wieder einzufuegen '.Send 'gleich senden .Display 'erst anzeigen End With Set OutApp = Nothing Set Email = Nothing Application.DisplayAlerts = True End Sub

Private Sub CommandButton1_Click() Dim FNamePDF As String, FPathPDF As String, FNameXL As String, FPathXL As String, strOldBody As _ String Dim Email As Object, OutApp As Object Dim InitializeOutlook Dim NewWB As Workbook ''Tabellenblatt als PDF speichern FPathPDF = "C:\Users\asafarr1\Desktop\Testordner\" FNamePDF = Range("F5").Value & "Test" & Format(Date, "YYYYMMDD") & ".pdf" 'Tabellennamen anpassen Sheets("Tabelle1").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FPathPDF & FNamePDF, Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ''Tabellenblatt als neue Excel Datei speichern 'Pfad anpassen, wenn anders FPathXL = "C:\Users\asafarr1\Desktop\Testordner\" FNameXL = Range("F5").Value & "Test" & Format(Date, "YYYYMMDD") & ".xlsm" 'Tabellennamen anpassen Set NewWB = Workbooks.Add ThisWorkbook.Sheets("Tabelle1").Copy Before:=NewWB.Sheets(1) NewWB.SaveAs Filename:=FPathXL & FNameXL, FileFormat:=xlOpenXMLWorkbookMacroEnabled ''als Email versenden Application.DisplayAlerts = False Set OutApp = CreateObject("Outlook.Application") InitializeOutlook = True Set Email = OutApp.CreateItem(0) With Email .GetInspector strOldBody = .HTMLBody .To = "vonmir@zudir.com" 'email Adresse eintragen '.CC = "" 'hier eventuelle Kopie Empfaenger .Subject = FName .Attachments.Add FPathPDF & FNamePDF .Attachments.Add FPathXL & FNameXL .HTMLBody = "Dein Text" & strOldBody 'hier deinen Text eingeben, das & strOldBody _ ist dazu da um deine Signatur wieder einzufuegen '.Send 'gleich senden .Display 'erst anzeigen End With Set OutApp = Nothing Set Email = Nothing Set NewWB = Nothing Application.DisplayAlerts = True End Sub

Moin Torsten,
Tolle Arbeit ! Wirklich. Vielen Dank!
weitere Fragen, (Kleinigkeiten..)
- Nach Auslösen öffnet sich die Excel tabelle, das braucht nicht, kann das abgestellt werden?
- Betreff fehlt, soll so heissen die eine der beide Dateien
- wie mach ich einen Absatz im Text, der schreibt setzt alles in einer Reihe,

Private Sub CommandButton1_Click()
Dim FNamePDF As String, FPathPDF As String, FNameXL As String, FPathXL As String, strOldBody As  _
_
String
Dim Email As Object, OutApp As Object
Dim InitializeOutlook
Dim NewWB As Workbook
''Tabellenblatt als PDF speichern
FPathPDF = "C:\Users\asafarr1\Desktop\Testordner1\"
FNamePDF = Range("F5").Value & "Test" & Format(Date, "DD.MM.YYYY") & ".pdf"
'Tabellennamen anpassen
Sheets("Ausdruck").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FPathPDF & FNamePDF, Quality:= _
_
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
''Tabellenblatt als neue Excel Datei speichern
'Pfad anpassen, wenn anders
FPathXL = "C:\Users\asafarr1\Desktop\Testordner2\"
FNameXL = Range("F5").Value & "Test" & Format(Date, "DD.MM.YYYY") & ".xlsm"
'Tabellennamen anpassen
Set NewWB = Workbooks.Add
ThisWorkbook.Sheets("Tabelle1").Copy Before:=NewWB.Sheets(1)
NewWB.SaveAs Filename:=FPathXL & FNameXL, FileFormat:=xlOpenXMLWorkbookMacroEnabled
''als Email versenden
Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
InitializeOutlook = True
Set Email = OutApp.CreateItem(0)
With Email
.GetInspector
strOldBody = .HTMLBody
.To = "vonmir@zudir.com"        'email Adresse eintragen
'.CC = ""                       'hier eventuelle Kopie Empfaenger
.Subject = FName
.Attachments.Add FPathPDF & FNamePDF
.Attachments.Add FPathXL & FNameXL
.HTMLBody = "Dein Text" & strOldBody    'hier deinen Text eingeben, das & strOldBody _
ist dazu da um deine Signatur wieder einzufuegen
'.Send          'gleich senden
.Display        'erst anzeigen
End With
Set OutApp = Nothing
Set Email = Nothing
Set NewWB = Nothing
Application.DisplayAlerts = True
End Sub

Beliebteste Forumthreads (12 Monate)

Excel als PDF > XLSX > Email angang

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel als PDF > XLSX > Email angang

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread