Outlook Datei auswählen, wie ?
02.02.2025 17:36:46
philipp
ich habe ein Makro von einem Freund erhalten.
Das Funktioniert einwandfrei aber dazu 2. Fragen:
1. Wie kann ich den Ordner auswählen, damit ich da die Datei auswählen möchte
es sollte eine XML Datei sein, müsste also vor der Frage als PDF eingefügt werden.
2. Wie ich den Bezug zu Mailadresse herstellen, diese steht in "O24".
Public Sub Neu_Orginal_Excel_Workbook_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim AWS As String
AWS = ThisWorkbook.FullName
'--------- hier NUR als PDF --------------------------------
If MsgBox(prompt:="Wollen Sie die Mappe als PDF senden?", _
Buttons:=vbYesNo Or vbQuestion, Title:="Abfrage") = vbYes Then
AWS = Mid$(AWS, 1, InStrRev(AWS, ".")) & "pdf"
Call ThisWorkbook.ExportAsFixedFormat(Type:=xlTypePDF, _
Filename:=AWS, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False)
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "" '
.Subject = "Rechnung: "
.Attachments.Add AWS
.Body = "Hier den Text einsetzen..."
.Display
End With
'------ hier NUR als XLS -------------------------------
Else
If MsgBox(prompt:="Wollen Sie die Mappe als XLSM senden?", _
Buttons:=vbYesNo Or vbQuestion, Title:="Abfrage") = vbYes Then
ThisWorkbook.Save 'als excel
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "" '
.Subject = "Rechnung: "
.Attachments.Add AWS
.Body = "Hier den Text einsetzen..."
.Display
End With
Else
'---- als PDF und XLS -------------------------------
If MsgBox(prompt:="Sollen PDF und XLS zusammen gesendet werden ?", _
Buttons:=vbYesNo Or vbQuestion, Title:="Abfrage") = vbYes Then
AWS = Mid$(AWS, 1, InStrRev(AWS, ".")) & "pdf"
Call ThisWorkbook.ExportAsFixedFormat(Type:=xlTypePDF, _
Filename:=AWS, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False)
'---- jetzt für xls Datei --------
Dim AWSEXECEL
AWSEXECEL = ThisWorkbook.FullName
'---------------------------------
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = ""
.Subject = "Rechnung: "
.Attachments.Add AWS
.Attachments.Add AWSEXECEL
.Body = "Hier den Text einsetzen..."
.Display
End With
End If
End If
End If
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
mfg philipp
Anzeige