Nach dem Speichern der PDF - Ordner öffnen
13.08.2023 15:48:34
Hendrik
Ich bin absoluter Beginner mit VBA in Excel trotzdem freue ich mich das der folgende Code funktioniert und mein Ziel erfüllt... Aber ich brauche einen Rat bei folgenden Problem.
Bei dem Klick auf dem Button wird ein Druckbereich per PDF unter einen fest definierten Speicherort gespeichert und anschließend eine Email erzeugt und in Outlook geöffnet. Die gespeicherte PDF wird als Emailanhang eingefügt.
Sub pdfemail()
'PDF erstellen und diese als Anlage an E-Mail einfügen.
'Mail-Versand im Anschluss über Outlook möglich
'Bestätigung - Überprüfung der eingeben Daten
Dim iClick As Integer
iClick = MsgBox( _
prompt:="Sind alle Angaben korrekt? Wollen Sie das Formular als PDF speichern und anschließend per Email versenden?", _
Buttons:=vbYesNo)
If iClick = vbYes Then
'Fehler vermeiden
On Error GoTo ErrHandler
'PDF Erstellen - In der Zelle FormOpt!P51 den Speicherpfad angeben!
'Die Zelle FormOpt!P52 Gibt den Dateinamen aus ggf. anpassen
Dim DateiName As String
DateiName = Range("FormOpt!P51") & Range("FormOpt!P52") & ".pdf"
'Druckbereich "FormLayout!A1:FormLayout!G48"
Range("FormLayout!A1:FormLayout!G48").ExportAsFixedFormat xlTypePDF, Filename:=DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=True, OpenAfterPublish:=False
'Email generieren
Dim Outlook As Object
Dim OutlookMailItem As Object
Dim Emailanhang As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set Emailanhang = OutlookMailItem.Attachments
With OutlookMailItem
'Emailempfänger wird aus aus Zelle FormOpt!P53 übernommen
.To = Range("FormOpt!P53").Value2
'Email-Betreff wird aus Zelle FormOpt!P54 übernommen
.Subject = Range("ReklaFormOpt!P54").Value2
'Emailtext wird aus der Zelle FormOpt!P55 übernommen
.Body = Range("FormOpt!P55").Value2
'Emailanhang
Emailanhang.Add DateiName
'Generierte Email anzeigen
.Display
End With
'App löschen
Set OutlookApp = Nothing
Set OutlookMailItem = Nothing
ErrHandler:
ElseIf iClick = vbNo Then
MsgBox "Dann überprüfen Sie die eingegeben Daten. Vorgang abgebrochen!"
End If
End sub
Sub pdfemail()
'PDF erstellen und diese als Anlage an E-Mail einfügen.
'Mail-Versand im Anschluss über Outlook möglich
'Bestätigung - Überprüfung der eingeben Daten
Dim iClick As Integer
iClick = MsgBox( _
prompt:="Sind alle Angaben korrekt? Wollen Sie das Formular als PDF speichern und anschließend per Email versenden?", _
Buttons:=vbYesNo)
If iClick = vbYes Then
'Fehler vermeiden
On Error GoTo ErrHandler
'PDF Erstellen - In der Zelle FormOpt!P51 den Speicherpfad angeben!
'Die Zelle FormOpt!P52 Gibt den Dateinamen aus ggf. anpassen
Dim DateiName As String
DateiName = Range("FormOpt!P51") & Range("FormOpt!P52") & ".pdf"
'Druckbereich "FormLayout!A1:FormLayout!G48"
Range("FormLayout!A1:FormLayout!G48").ExportAsFixedFormat xlTypePDF, Filename:=DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=True, OpenAfterPublish:=False
'Email generieren
Dim Outlook As Object
Dim OutlookMailItem As Object
Dim Emailanhang As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set Emailanhang = OutlookMailItem.Attachments
With OutlookMailItem
'Emailempfänger wird aus aus Zelle FormOpt!P53 übernommen
.To = Range("FormOpt!P53").Value2
'Email-Betreff wird aus Zelle FormOpt!P54 übernommen
.Subject = Range("ReklaFormOpt!P54").Value2
'Emailtext wird aus der Zelle FormOpt!P55 übernommen
.Body = Range("FormOpt!P55").Value2
'Emailanhang
Emailanhang.Add DateiName
'Generierte Email anzeigen
.Display
End With
'App löschen
Set OutlookApp = Nothing
Set OutlookMailItem = Nothing
ErrHandler:
ElseIf iClick = vbNo Then
MsgBox "Dann überprüfen Sie die eingegeben Daten. Vorgang abgebrochen!"
End If
End sub
Wie kann ich realisieren, dass nach dem Speichern der PDF der Ordner geöffnet wird, wo die PDF gespeichert ist. Also nicht die PDF in einen Reader sondern wirklich der Ordner im Explorer wo die Datei auch liegt.
Für eure Hilfe wäre ich sehr Dankbar...