Excelblatt speichern und versenden
07.04.2022 16:52:25
Thomas
Ich habe mit meinem Makro (siehe unten) folgendes Problem und bin auf Hilfe angewiesen.
Beim Öffnen der zugrunde liegenden Datei und ausführen des Makros, wirft er mir immer beim ersten Mal folgenden Fehler aus: Laufzeitfehler `2147024894 (80070002) Die Datei kann nicht gefunden werden. Überprüfen Sie den Pfad und den Dateinamen!
Wenn ich den Debugger beende und den Fehler somit ignoriere und den Ordner manuell anklicke wo die PDF gespeichert werden soll, läuft das Makro ohne Probleme und macht das, wofür ich es gerne hätte. Naja Zumindetens bis zum schließen und dann erneuten öffnen der zugrunde liegenden Datei.
Ich kann die Datei doch nicht 24/7 offen lassen ☹
Wo liegt mein Fehler?
Sub Schaltfläche36_Klicken()
Worksheets("Bestellformular").Calculate
'** Dimensionierung der Variablen
Dim strPDF As String
Dim OutlookApp As Object, strEmail As Object
'** Vorgaben definieren
Set OutlookApp = CreateObject("Outlook.Application")
Set strEmail = OutlookApp.CreateItem(0)
'** PDF erzeugen
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path
pdfDateiName = ActiveSheet.Range("B3") & "_" & Range("C3") & "_" & Range("B25") & "_" & Range("A70") & "_" & Range("B17") & "_" & Range("B8") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfDateiName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
Range("C3") = Range("C3") + 1
If Range("E6").Value = "" Then
MsgBox "Bitte füllen Sie das Feld Kontierung aus", vbCritical, "Werte ausfüllen.."
Exit Sub
End If
Sheets("Bestellformular").Select
'** E-Mail versenden
strPDF = ThisWorkbook.Path
With strEmail
strPDF = Application.GetSaveAsFilename(InitialFileName:=pdfDateiName, FileFilter:="PDF files, *.pdf", Title:="PDF speichern")
With strEmail
.To = "test@.INFO"
.Subject = "Bestellung Fahrauftrag" 'Betreffzeile
.htmlBody = "Hallo Kollegen,
wir bitten um zeitnahe Bearbeitung.
" & _
"Die Fahrauftragsnummer lautet wie folgt: " & Range("B3") & "_" & Range("C3") - 1 & " " & "für folgenden Liefer,-Abholort:" & " " & Range("B25") & " " & "für" & " " & Range("A70") & " " & "zum" & " " & Range("B17") & " " & "auf die Kontierung" & " " & Range("E6") & _
"
mit freundlichen Grüßen Euer SNB Team" & olOldbody
'Empfangsbestätigung:
'.ReadReceiptRequested = False
.Attachments.Add strPDF
.Display
'.Send 'Damit wir die E-Mail sofort versendet
End With
'** Objektvariablen wieder löschen
Set OutlookApp = Nothing
Set strEmail = Nothing
End With
End Sub