Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1700to1704
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Teil 2/ Aus Excel Email versenden mit Anhang
09.07.2019 11:04:09
botfaehig
Hallo zusammen,
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
"

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Teil 2/ Aus Excel Email versenden mit Anhang
10.07.2019 09:51:46
Marco
Hallo,
ich hoffe ich habe Dich mit Aufräumen richtig verstanden.
Ich habe alles rausgeschmissen was Du nicht mehr brauchst wenn nur die Exceldatei verschickt werden soll.
Die Abholauftragnummer habe ich in den Betreff und in die Mail eingefügt.
Auch habe ich das Format vom HTML-Body etwas übersichtlicher formatiert.
So solltest Du es auch besser verstehen und kannst es einfacher anpassen und ggf. weitere Zeilen hinzufügen.
Wichtig: Du musst im Makro noch die # entfernen - Diese musste ich einbauen, damit es hier im Forum korrekt angezeicht wird.
Ich habe ein paar HTML-Tags eingebaut hat zum Zeilenumbruch in der Email.
Viele Grüße
Marco
Private Sub CommandButton1_Click()
Dim FNameXL As String, FPathXL As String, strOldBody As String
Dim Email As Object, OutApp As Object
Dim InitializeOutlook
Dim NewWB As Workbook
''Tabellenblatt als neue Excel Datei speichern
'Pfad anpassen, wenn anders
'Application.ScreenUpdating = False
FPathXL = "C:\Temp\" ' Pfad anpassen
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 = "empfaenger@email.com"        'email Adresse eintragen
'.CC = ""                       'hier eventuelle Kopie Empfaenger
.Subject = FNameXL & " - Abholauftragnummer: " & Range("J3").Value
'.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." _
& "Abholauftragnummer: " & Range("J3").Value & "" _
& "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

Anzeige
AW: Teil 2/ Aus Excel Email versenden mit Anhang
10.07.2019 10:55:29
botfaehig
Wow, Super!!!
Danke vielmals für Deine Zeitopferung.
2 Sachen noch .
1 - er Melden mir bei auslösen (Datei bereits vorhanden, soll diese ersetzt werden? ) da ist aber nicht vorhanden (wen ich sage ja email geht auf und alles ok ) wenn nei bricht er ab.
- es soll ja eine Datei geholt werden. (das tut es auch, aber warum diese Frage?
2 - kann man eine Fehlermeldung ausgabe einbauen ? wenn es nach Datei gesucht wird ".Attachments.Add Range("B1").Value" die so heißt; "FNameXL = Range("B5").Value & "" & Format(Date, " DD.MM.YYYY") & ".xlsm"
nicht vorhanden ist das eine Fehlermeldung kommt "Datei nicht vorhanden"
Vielen Dank
Private Sub CommandButton1_Click()
Dim FNameXL As String, FPathXL As String, strOldBody As String
Dim Email As Object, OutApp As Object
Dim InitializeOutlook
Dim NewWB As Workbook
''Tabellenblatt als neue Excel Datei speichern
'Pfad anpassen, wenn anders
'Application.ScreenUpdating = False
'FPathXL = "C:\Users\asafarr1\Desktop\Testordner1\" ' Pfad anpassen
FNameXL = Range("Q1").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 = "empfaenger@email.com"        'email Adresse eintragen
'.CC = ""                       'hier eventuelle Kopie Empfaenger
.Subject = FNameXL & " - Abholauftragnummer: " & Range("J3").Value
'.Attachments.Add FPathPDF & FNamePDF
'.Attachments.Add FPathXL & FNameXL
.Attachments.Add Range("D4").Value
'.Attachments.Add "W:\Conflans JIT 2019.06.27.xlsx"
.HTMLBody = "Hallo Herr Muehlbach," _
& "im Anhang finden Sie unseren neuen Abruf." _
& "Abholauftragnummer: " & Range("J3").Value & "" _
& "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

Anzeige
AW: Teil 2/ Aus Excel Email versenden mit Anhang
10.07.2019 13:15:34
Marco
Hallo,
1 - er Melden mir bei auslösen (Datei bereits vorhanden, soll diese ersetzt werden? ) da ist aber nicht vorhanden (wen ich sage ja email geht auf und alles ok ) wenn nei bricht er ab.
- es soll ja eine Datei geholt werden. (das tut es auch, aber warum diese Frage?
Er holt keine Datei bzw. Excel erstellt die Datei erst für die Email aus der aktuellen Datei. In dem Fall scheint schon eine Datei mit dem Namen+Datum vorhanden Sein. Am besten kannst Du das kontrollieren wenn Du den Pfad angeben -
'FPathXL = "C:\Users\asafarr1\Desktop\Testordner1\" ' Pfad anpassen ist ja auskommentiert.
ändere das einmal in:
FPathXL = "C:\Users\asafarr1\Desktop\Testordner1\" ' Pfad anpassen
2 - kann man eine Fehlermeldung ausgabe einbauen ? wenn es nach Datei gesucht wird ".Attachments.Add Range("B1").Value" die so heißt; "FNameXL = Range("B5").Value & "" & Format(Date, " DD.MM.YYYY") & ".xlsm"
nicht vorhanden ist das eine Fehlermeldung kommt "Datei nicht vorhanden"
Die Datei ist immer vorhanden, weil das attachment ja erst bei deinem Klick auf den Button erstellt wird. (Siehe auch 1)
VG
Marco
Vielen Dank
Anzeige
AW: Teil 2/ Aus Excel Email versenden mit Anhang
10.07.2019 14:39:18
botfaehig
Hi Marco,
also nicht so ganz..
ich hole eine Datei die bereits in bestimmten Ort liegt.
Den Pfad, wo die Datei ins Email geholt werden soll ziehe ich über:
.Attachments.Add Range("D4").Value (Also in D4 steht das Pfad)
und falls diese Datei doch nicht gefunden wird, soll Fehlerbeschreibung kommen, Datei nicht vorhanden.
Das ein Bestimmtes Datenblatt aus Excel wo das Script geschrieben ist, mit gespeichert und gesendet wird, ist momentan auskommentiert. werde ich in 2ten Stepp machen.
Vielen Dank

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige