Office: Tabelle in pdf exportieren und dann zusammen mit excel-datei per E-MAIL verschicken

Helfe beim Thema Tabelle in pdf exportieren und dann zusammen mit excel-datei per E-MAIL verschicken in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, ich habe einen Dienstplan für Januar erstellt und diesen als xlsm-Datei gespeichert. Ich möchte in dieser einen Button haben, der folgendes... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von mglinka99, 18. Oktober 2019.

Seite 1 von 2

MGLINKA99

mglinka99

Tabelle in pdf exportieren und dann zusammen mit excel-datei per E-MAIL verschicken

Hallo,

ich habe einen Dienstplan für Januar erstellt und diesen als xlsm-Datei gespeichert. Ich möchte in dieser einen Button haben, der folgendes auslöst:

Die Datei als pdf speichern und dann die bereits vorhandene excel-datei zusammen mit der PDF-Datei verschicken. Dabei soll die pdf den gleichen Namen haben wie die xlsm-Datei. Auch soll meine Signatur, die ich im Outlook habe, übernommen werden.

Ich habe schon folgenden Code gefunden:

Code:

Sub AktiveTabelleAlsAnhang()

Application.DisplayAlerts = False

Dim aws As String

Dim olapp As Object

'ActiveWorkbook.ActiveSheet.Copy

ActiveWorkbook.Save

aws = ActiveWorkbook.FullName

Set olapp = CreateObject("Outlook.Application")

With olapp.CreateItem(0)

.to = "mail@server.de" 'Empfänger

'.cc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Kopie an

'.bcc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Blindkopie an

* '.ReadReceiptRequested = True ' optional Lesbestätigung anfordern

** .htmlbody = "Text" 'Optional Body

** .Subject = "Text" 'Betreff optional

** .ReadReceiptRequested = True 'optional Lesebestätigung anfordern

** .Attachments.Add aws

** .display

** 'SendKeys "%s", True ' optional Mail sofort senden

** End With

** Set olapp = Nothing

** Application.DisplayAlerts = True

** End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielleicht kann mir jemand beim Erweitern helfen.

Anbei auch die excel-datei.

Danke

:)

mglinka99, 18. Oktober 2019

#1
MGLINKA99

mglinka99

Ok. Was ich schon mal begriffen habe, dass es mit der Signatur nicht möglich ist, weil die E-Mail über das SendTo verschickt wird und dort keine Signaturen unterstützt werden. Das ist nicht so schlimm, muss ich diese vorm Verschicken manuell hinzufügen.

Was ich nicht verstehe, warum beim o.g. Code die gesamte Datei verschickt wird und nicht, wie gewünscht, nur die aktive Tabelle aus der ich das Makro ausführe.

Vielleicht kann jemand helfen.

Danke

mglinka99, 22. Oktober 2019

#2
REGINAR

ReginaR

Hi,
mit dieser Zeile hängst Du die gesamte gespeicherte datei an die Mail an:

.Attachments.Add aws

Wenn Du nur ein Blatt verschicken wolls, musst Du das entsprechende Blatt (Wenn Du den Button anklickst, ist das das ActiveSheet) in eine neue Datei kopieren, diese speichern und dann diese Datei verschicken.

ReginaR, 22. Oktober 2019

#3
REGINAR

ReginaR

Tabelle in pdf exportieren und dann zusammen mit excel-datei per E-MAIL verschicken

Hi,
ich habe eben mal gesucht, weil ich das mit der Signatur auch mal gelöst hatte. Im folgenden Code habe ich die Vorschlag vom ersten Post eingebaut, außerdem die Ausgabe einer Signatur. Du musst nur in der gekennzeichneten zeile, den Namen Deiner Signatur aus Outlook eingeben.

Code:

Sub AktiveTabelleAlsAnhang()
Application.DisplayAlerts = False
Dim aws As String
Dim olapp As Object
Dim str_signatur_pfad As String
Dim str_signatur_name As String
Dim str_signatur
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs ActiveSheet.Name & ".xlsx"
aws = ActiveWorkbook.FullName

str_signatur_name = "Extern" ' hier den Namen der Signatur aus Outlook angeben
str_signatur_pfad = Environ("appdata") & "MicrosoftSignatures" & str_signatur_name & ".htm"
If Dir(str_signatur_pfad) "" Then
str_signatur = GetSignature(str_signatur_pfad)
Else
str_signatur = ""
End If

Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.to = "mail@server.de" 'Empfänger
'.cc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Kopie an
'.bcc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Blindkopie an
'.ReadReceiptRequested = True ' optional Lesbestätigung anfordern
.htmlbody = "Text" & "" & str_signatur 'Optional HTMLBody = Zeilenumbruch
.Subject = "Text" 'Betreff optional
.ReadReceiptRequested = True 'optional Lesebestätigung anfordern
.Attachments.Add aws
.display
'SendKeys "%s", True ' optional Mail sofort senden
End With
ActiveWorkbook.Close
Kill aws ' Löscht die erstellte Datei wieder
Set olapp = Nothing
Application.DisplayAlerts = True
End Sub

Function GetSignature(fPath As String) As String
Dim fso As Object
Dim TSet As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set TSet = fso.getfile(fPath).OpenAsTextStream(1, -2)
GetSignature = TSet.readall
TSet.Close
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ReginaR, 22. Oktober 2019

#4
MGLINKA99

mglinka99

Danke schon mal für den Code für die Signature. Diesen werde ich testen, wenn ich wieder am Arbeitsplatzrechner bin.

ich bin gerade dabei einen bestimmten Bereich einer Excel-Tabelle per E-Mail zu verschicken. Dabei habe ich folgenden Code gefunden:

Code:

Sub Mail_Range()
'Working in Excel 2000-2016
'For Tips see: Excel Automation - Ron de Bruin
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:AI43").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

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

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & ""
TempFileName = wb.Name

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

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "emailadresse"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das funktioniert schon mal ganz gut, eine Sache ist jedoch etwas unschön.

Die Quelldatei, aus der die Daten gezogen werden, heißt: Dienstzeiten 01.2020.xlsm

Wenn ich nun den o.g. Code verwende, wird ein Attachment erstellt mit dem Dateinamen Dienstzeiten 01.2020.xlsm.xlsx

Die Endung .xlsm möchte ich gerne weghaben. Das bedeutet die Angehängte Datei soll Dienstzeiten 01.2020.xlsx heißen.

Vielleicht kann mir jemand helfen?

Danke

mglinka99, 24. Oktober 2019

#5
MGLINKA99

mglinka99

ich bin nun einen Schritt weiter.

Excel- und PDF-Datei werden mit richtiger Benennung an die E-Mail angehängt.
Hier dazu der aktuelle Code:

Code:

Sub Mail_Range()
'Working in Excel 2000-2016
'For Tips see: Excel Automation - Ron de Bruin
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim TempFilePDF As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:AI43").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

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

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & ""
TempFileName = Left(ThisWorkbook.Name, _
InStrRev(ThisWorkbook.Name, ".") - 1) & FileExtStr

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
TempFilePDF = Left(TempFileName, InStrRev(TempFileName, ".")) & "pdf"

ThisWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr
', FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
.Attachments.Add TempFilePDF
'You can add other files also like this
'.Attachments.Add ("C:test.txt")
'.Send 'or use
.Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Was mich jetzt noch stört, dass die Formateigenschaften der Quelldate nicht an die Zieldatei (Excel & PDF) übergeben werden.

Beispiel: Die Tabelle ist in der Quelldatei im Querformat bei einer Skalierung von 55 %. in der Zieldatei im XLSX ist die Tabelle im Hochformat, Skalierung auf 100 und auch die Seitenränder wurden nicht übernommen

Wie kann ich das lösen?

mglinka99, 25. Oktober 2019

#6
MGLINKA99

mglinka99

So. Ich konnte meine Anliegen durch Recherche und Probieren selbst lösen.

Falls jemand mal in ähnliche Richtung arbeitet, hier ist der Code:

Code:

Sub Mail_Range()
'Working in Excel 2000-2016
'For Tips see: Excel Automation - Ron de Bruin
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim TempFilePDF As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:AI43").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

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

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy

With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

Application.PrintCommunication = False
With Dest.Sheets(1).PageSetup
.LeftMargin = Application.CentimetersToPoints(0.8)
.RightMargin = Application.CentimetersToPoints(0.8)
.TopMargin = Application.CentimetersToPoints(1)
.BottomMargin = Application.CentimetersToPoints(0)
.Orientation = xlLandscape
.CenterHorizontally = True
.Zoom = 55
End With
ActiveWindow.Zoom = 55
Application.PrintCommunication = True

TempFilePath = Environ$("temp") & ""
TempFileName = Left(ThisWorkbook.Name, _
InStrRev(ThisWorkbook.Name, ".") - 1) & FileExtStr

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
TempFilePDF = Left(TempFileName, InStrRev(TempFileName, ".")) & "pdf"

ThisWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr
', FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "mailadresse"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
.Attachments.Add TempFilePDF
'You can add other files also like this
'.Attachments.Add ("C:test.txt")
'.Send 'or use
.Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Thema als erledigt markiert.

mglinka99, 25. Oktober 2019

#7
REGINAR

ReginaR

Tabelle in pdf exportieren und dann zusammen mit excel-datei per E-MAIL verschicken

Hi, nochmal zu der Signatur-Funktion. Da hatte bei meinem Post der Backslash-Klau wieder zugeschlagen. Diese Zeile muss so heißen:

str_signatur_pfad = Environ("appdata") & "MicrosoftSignatures" & str_signatur_name & ".htm"

ReginaR, 25. Oktober 2019

#8
MGLINKA99

mglinka99

ok Danke. Funktioniert leider trotzdem nicht. Die Signatur wird nicht angehängt.

liegt es vielleicht daran, dass beim Dim str_signstur was fehlt?

mglinka99, 26. Oktober 2019

#9
KNOBBI38

knobbi38

Hallo,

hier ist das Thema auch schon mal behandelt worden:
https://stackoverflow.com/a/15161351

Ulrich

knobbi38, 26. Oktober 2019

#10
REGINAR

ReginaR

... daran kann es nich tliegen, ich habe nur das "as string" vergessen. Hast Du den Namen der Signatur genau so in dieser Zeile eingegeben, wie die Signatur in Outlook heißt?

Code:

str_signatur_name = "Extern"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ReginaR, 26. Oktober 2019

#11
MGLINKA99

mglinka99

Ja habe den Namen der Signatur eingetragen. Es kommt auch keine Fehlermeldung.

Zur Info: Am Arbeitsplatz nutze ich Outlook 2010 und Excel 2010.

Die Pdf-Sache funktioniert hier am Arbeitsplatz auch nicht, bei meinem Heim-PC mit Office 2019 schonm

mglinka99, 26. Oktober 2019

#12
REGINAR

ReginaR

Tabelle in pdf exportieren und dann zusammen mit excel-datei per E-MAIL verschicken

ok, mit Office 2010 kann ich nicht (merh) testen.
Du kannst höchstens mal schrittweise den Code ablaufen lassen und schauen, ob die Function einen wert zurückliefert und was in str_signatur_pfad steht.

Code:

str_signatur = GetSignature(str_signatur_pfad)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ReginaR, 26. Oktober 2019

#13
MGLINKA99

mglinka99

dann bekomm ich meldung : "Datei nicht gefunden" und der Debugger springt zu: Code:

Set TSet = fso.getfile(fPath).OpenAsTextStream(1, -2)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mglinka99, 26. Oktober 2019

#14
REGINAR

ReginaR

...ok, dann weiß ich auch nicht weiter, hängt dann wohl mit er Version zusammen...

ReginaR, 26. Oktober 2019

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 2

Thema:

Tabelle in pdf exportieren und dann zusammen mit excel-datei per E-MAIL verschicken

Die Seite wird geladen...

Tabelle in pdf exportieren und dann zusammen mit excel-datei per E-MAIL verschicken - Similar Threads - Tabelle pdf exportieren
PDF aus Tabelle erstellen mit Autofilter
in Microsoft Excel Hilfe
PDF aus Tabelle erstellen mit Autofilter: Guten Tag zusammen Ich sitze nun schon seit 4 Stunden an einem Problem welches ich einfach nicht lösen kann: Wir haben eine Pendenzenliste für diverse Teilnehmer erstellt. Tabellenname:...
Pdf Export von mehreren Tabellen
in Microsoft Excel Hilfe
Pdf Export von mehreren Tabellen: Habe Office 2010 im Einsatz und möchten nun von einem File mehrere Tabellen Blätter exportieren. Private Sub CommandButton1_Click() Sheets(Array("Tabelle1", "Tabelle2",...
Tabelle aus XPS/PDF in Excel importieren
in Microsoft Excel Hilfe
Tabelle aus XPS/PDF in Excel importieren: Ich habe hier eine mehrseitige, recht einfach aufgebaute, Tabelle, die ich gern in Excel importieren würde; das Wartenwirtschaftssystem exportiert nach .oxps und ich kann per Druckertreiber in PDF...
Excel Tabelle aus PDF erstellen? (NUR durch Strg-C und Strg-V !!!)
in Microsoft Excel Hilfe
Excel Tabelle aus PDF erstellen? (NUR durch Strg-C und Strg-V !!!): Hallo liebe Excel Freunde. Ich habe ein Problem :( Klar... sonst würde ich mich nicht hier melden. Ich habe eine PDF mit Zeitdaten von Mitarbeitern. Darin enthalten ist das "Kommen", das...
Makro drucken in Pivot Tabelle als pdf
in Microsoft Excel Hilfe
Makro drucken in Pivot Tabelle als pdf: Liebe Forengemeinschaft Ich möchte gerne eine Pivot Tabelle als pdf drucken. Dabei soll der Speicherort fix sein und der Dateiname aus 2 Felder in der Pivot kommen, das pdf soll nicht...
Tabellenlinien sind in der pdf-Ansicht ansatzweise sichtbar!
in Microsoft Word Hilfe
Tabellenlinien sind in der pdf-Ansicht ansatzweise sichtbar!: Hallo, ich brauche dringend Hilfe bzgl. meiner Masterarbeit. Ich habe mehrere Tabellen in Word erstellt und wenn ich mein Dokument in der pdf-Version auf 100% betrachte, sieht man, dass bei...
PDF mit Excel-Tabelle abgleichen
in Microsoft Excel Hilfe
PDF mit Excel-Tabelle abgleichen: Hallo zusammen, ich suche eine Lösung um ein oder mehrere PDF's mit einer Excel-Tabelle abzugleichen. Meine erste Idee war, einen Katalogsindex in Adobe Pro zu erstellen und diesen mit einem...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden