Datei neu speichern, als Anhang senden
10.11.2021 21:47:48
Moritz
folgende Schritte möchte ich mit einem Code lösen und automatisieren:
1. Abfrage ob alle Pflichtfelder ausgefüllt sind. Wenn nicht, Fehlermeldung und Code-Stopp.
2. Speichern der ausgefüllten Masterdatei unter einem neuen Dateinamen. Pfad kann weiterhin manuell gewählt werden.
3. Verschicken dieser neuen Datei als Anhang, automatisches Öffnen von Outlook inkl. vorgeschriebenen Betreff und Text.
Ich habe noch nicht viel Kenntnis von VBA und habe mir aus diversen Beiträgen folgenden Code erarbeitet, verschicke aber immer nur die Masterdatei, nicht die neue:
Sub Senden()
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
AWS = ActiveWorkbook.FullName
Set Nachricht = OutApp.CreateItem(0)
Dim c As Range
For Each c In Worksheets("Formular Retoure").Range("a9, a13, a15, a17, b17, d9, d11, f9")
If c = "" Then
Cancel = True
MsgBox c.Address & " Mandatory Field" & vbCr & c.Address & " Pflichtfeld"
Exit Sub
c.Parent.Select
c.Activate
Exit For
End If
If c >= "" Then
Cancel = False
c.Parent.Select
c.Activate
Dim DateiName As String
End If
Next
With Speichern
Dim Name
Name = Application.GetSaveAsFilename("C:\Desktop\" & "Retoureanmeldung_Kundennummer: " & Worksheets("Formular Retoure").Range("a9").Text & "_" & Worksheets("Formular Retoure").Range("d9").Text & "_" & Worksheets("Formular Retoure").Range("f9").Text & ".xlsm", fileFilter:="Microsoft Excel-Arbeitsmappe (*.xlsm), *.xlsm")
If Name False Then
ActiveWorkbook.SaveAs Name, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
AWS = ActiveWorkbook.FullName
Set Nachricht = OutApp.CreateItem(0)
End If
Next
With Nachricht
.to = Worksheets("Formular Retoure").Range("f13").Text
.Subject = "Retoureanmeldung_Kundennummer: " & Worksheets("Formular Retoure").Range("a9").Text & "_" & Worksheets("Formular Retoure").Range("d9").Text & "_" & Worksheets("Formular Retoure").Range("f9").Text
.attachments.Add AWS
.Body = "Hallo Zusammen," & vbCr _
& vbCr _
& "anbei sende ich eine Retourenanmeldung inkl. Bitte um Versand des Lieferscheins und Paketaufklebers an folgende E-Mail Adresse: " & Worksheets("Formular Retoure").Range("a15").Text & vbCr _
& vbCr _
& "Danke und viele Grüße" & vbCr _
& vbCr _
.Display
End With
End Sub
>Ggf. hat hier jemand ja eine Idee wie ich diesen Code ändern oder sogar kürzen kann und trotzdem an mein Ziel komme.
Vielen Dank vorab!
Grüße
Moritz