|
Danke für die schnelle Antwort, ich habe das so umgesetzt. Leider speichert er die Datei nicht ab, obwohl er ohne Fehler durchläuft!?
Der Code sieht jetzt so aus:
Private Sub Speichern()
Dim strFilePath As String
Dim strExpr As String
strFilePath = "\\...\###Stellungnahmen\<BEZ.0>\<BEZ.1>\5.1_<BEZ.2>_I_Prüfung_Harte Kriterien_<BEZ.3>.pdf"
'0. Bezeichner
strExpr = Range("F2").Value
strFilePath = Replace$(strFilePath, "<BEZ.0>", Trim$(strExpr), Compare:=vbTextCompare)
'1. Bezeichner
strExpr = Range("C23").Value & " " & Range("F23").Value
strFilePath = Replace$(strFilePath, "<BEZ.1>", Trim$(strExpr), Compare:=vbTextCompare)
'2. Bezeichner
strExpr = Range("H2").Value
strFilePath = Replace$(strFilePath, "<BEZ.2>", Trim$(strExpr), Compare:=vbTextCompare)
'3. Bezeichner
strExpr = Range("A29").Value
strFilePath = Replace$(strFilePath, "<BEZ.3>", Trim$(strExpr), Compare:=vbTextCompare)
Debug.Print strFilePath
'Speichern als .pdf
ActiveSheet.Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:="strFilePath", OpenAfterPublish:=False
Application.DisplayAlerts = True 'Fehlermeldungen an
MsgBox "Datei erfolgreich exportiert.", , p_cstrMsgTitel
Mailsenden
DateiSchließen_ohne_speichern
End Sub
Private Sub Mailsenden()
Dim olApp As Object
Dim WsShell
Set olApp = CreateObject("Outlook.Application")
Dim strFilePath As String
Dim strExpr As String
strFilePath = "\\...\###Stellungnahmen\<BEZ.0>\<BEZ.1>\5.1_<BEZ.2>_I_Prüfung_Harte Kriterien_<BEZ.3>.pdf"
'0. Bezeichner
strExpr = Range("F2").Value
strFilePath = Replace$(strFilePath, "<BEZ.0>", Trim$(strExpr), Compare:=vbTextCompare)
'1. Bezeichner
strExpr = Range("C23").Value & " " & Range("F23").Value
strFilePath = Replace$(strFilePath, "<BEZ.1>", Trim$(strExpr), Compare:=vbTextCompare)
'2. Bezeichner
strExpr = Range("H2").Value
strFilePath = Replace$(strFilePath, "<BEZ.2>", Trim$(strExpr), Compare:=vbTextCompare)
'3. Bezeichner
strExpr = Range("A29").Value
strFilePath = Replace$(strFilePath, "<BEZ.3>", Trim$(strExpr), Compare:=vbTextCompare)
Debug.Print strFilePath
With olApp.CreateItem(0)
.To = "f3@abc.de" 'Empfänger"
.cc = "fw@abc.de" & "; " & "fw2@abc.de" 'Optional Kopie an
.Subject = "Harte Kriterien zur Anfrage " & Range("A29") 'Betreff
.Body = _
"Hallo ," & vbCrLf & vbCrLf & "eine Prüfung liegt vor." 'Nachricht
.ReadReceiptRequested = False 'Lesebestätigung aus
.Display 'Email anzeigen
.Attachments.Add strFilePath
Set WsShell = CreateObject("WScript.Shell") 'versenden
WsShell.AppActivate olApp
WsShell.SendKeys ("%s")
End With
End Sub
Wo liegt der Fehler, dass er keine Datei ablegt und somit auch bei dem Sub Mailsenden() auf einen Fehler läuft, wenn er die Datei anhängen soll!?
Danke und Grüße
Christian
|