Thorsten hat mir mal geholfen und diesen Script hier geschrieben.
kann mir einer helfen beim Aufräumen, ich habe es versucht ein wenig anzupassen :) ?
In diesem Fall möchte ich beim Klicken NUR:
- Exceldadei aus vorgegebenen Speicherort holen und in Email anhängen.
- und im Text: also in .HTMLBody = ... Sollte zusätzlich zu bereits bestehenden Infos, noch aufgenommen werden das Wort: "Abholauftragnummer" plus das was in "J3" steht. da wird nämlich die Nummer stehen.
Danke Euch allen ! ---------------------------------------
"
Private Sub CommandButton1_Click()
Dim FNamePDF As String, FPathPDF As String, FNameXL As String, FPathXL As String, strOldBody As _
_
_
String
Dim Email As Object, OutApp As Object
Dim InitializeOutlook
Dim NewWB As Workbook
''Tabellenblatt als PDF speichern
'FPathPDF = "C:\Users\asafarr1\Desktop\Testordner1\"
FPathPDF = Range("B2").Value
FNamePDF = Range("C3").Value & "" & Format(Date, " DD.MM.YYYY") & ".pdf"
'Tabellennamen anpassen
Sheets("Ausdruck").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FPathPDF & FNamePDF, Quality:= _
_
_
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
''Tabellenblatt als neue Excel Datei speichern
'Pfad anpassen, wenn anders
'Application.ScreenUpdating = False
'FPathXL = "C:\Users\asafarr1\Desktop\Testordner2\"
FNameXL = Range("B5").Value & "" & Format(Date, " DD.MM.YYYY") & ".xlsm"
'Tabellennamen anpassen
Set NewWB = Workbooks.Add
'ThisWorkbook.Sheets("Schedule Export").Copy Before:=NewWB.Sheets(1)
NewWB.SaveAs Filename:=FPathXL & FNameXL, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Workbooks(FNameXL).Close savechanges:=True
Application.ScreenUpdating = True
''als Email versenden
Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
InitializeOutlook = True
Set Email = OutApp.CreateItem(0)
With Email
.GetInspector
strOldBody = .HTMLBody
.To = "vonmir@zudir.com" 'email Adresse eintragen
'.CC = "" 'hier eventuelle Kopie Empfaenger
.Subject = FNamePDF
'.Attachments.Add FPathPDF & FNamePDF
'.Attachments.Add FPathXL & FNameXL
.Attachments.Add Range("B1").Value
'.Attachments.Add "W:\Conflans JIT 2019.06.27.xlsx"
.HTMLBody = "Hallo Herr Muehlbach," & "
" & "
" & "im Anhang finden Sie unseren _
_
_
neuen Abruf." & "
" & "Bitte informieren Sie mich sofort bei Unstimmigkeiten" & "
" & _
strOldBody 'hier deinen Text eingeben, das & strOldBody _
ist dazu da um deine Signatur wieder einzufuegen
'.Send 'gleich senden
.Display 'erst anzeigen
End With
Set OutApp = Nothing
Set Email = Nothing
Set NewWB = Nothing
Application.DisplayAlerts = True
End Sub
"