Speichern unter und per Mail senden VBA
17.08.2016 14:49:11
soldierart@web.de
habe mir ein Makro zusammengebastelt aus dem Netz, welches das aktive Workbook speichern soll und per E-Mail an eine zentrale Stelle geschickt werden soll.
Da die Datei bei allen unterschiedlich heißen wird (persönliche Nummer und Datum) am Schluss, habe ich variablen E1, D1 und E2 angelegt. Die Datei soll immer auf Laufwerk H im Ordner Datei abgespeichert werden. Hier liegt mein Problem. Das Makro speichert mir die Datei immer auf dem Desktop oder im Ordner eigene Dateien ab. Woran liegt das?
Hier das Makro:
Sub SpeichernUndSenden()
Dim PName As String
Dim MName As String
Dim JName As String
Dim Dateiname As String
Dim pfad As String
Dim olApp As Object
Dim objMail As Object
PName = Range("E2")
MName = Range("D1")
JName = Range("E1")
Dateiname = PName & "_" & MName & JName & ".xls"
pfad = "H:\Datei"
ActiveWorkbook.SaveAs Filename:=pfad & Dateiname
Set olApp = CreateObject("Outlook.Application")
Set objMail = olApp.CreateItem(0)
With objMail
.To = "Alpha@Bravo.com"
.Subject = "Datei " & PName
.Body = "Hier die Datei " & MName & JName & vbNewLine & .Body
.Attachments.Add ActiveWorkbook.FullName
.Send
MsgBox "Die Datei wurde unter " & Range("H2") & " abgelegt" & " und an Anna @ Bravo per _
Mail versandt."
End With
Set objMail = Nothing
Set olApp = Nothing
End Sub