Hallo,
ich habe am 20.10. eine Beitrag zum Versenden eines Anhangs (ursprünglich Excel-xlsm; Anhang als Kopie in xlsx ) per Outlook erstellt. Leider habe ich den Beitrag als gelöst geschlossen und kann nicht mehr auf diesen zugreifen. Deshalb nun als Teil II, sorry. Für mich ist es überhaupt sehr schwierig, mich mit "Beitrag erstellen" und dann auf Antworten zurückzuschreiben zurechtzufinden, dauert immer eine Ewigkeit bis ich antworten kann; weiß nicht ob das an mir liegt oder wies besser geht.

Thema:
die Lösung, die ich dankenswerterweise bekommen habe, funktioniert insgesamt gut. Gerne möchte ich noch einen kleine Verbesserung schaffen, da ich die Datei sehr häufig versenden muss und es jedesmal sehr aufwendig ist, diese in einem ewig langen Pfad zu speichern.

Frage:
kann im unteren Teil bei Sub Kopie speichern eine automatische Speicherung an einem zugewiesenen Pfad durchführen (zB "X:\Allgemein\QM"? Die Massagebox benötige ich nicht, der Dateiname soll der gleiche sein, wie im Anhang (ist jedoch nicht die höchste Priorität, wenn er anders ist, ists auch okay).

Danke!!!


Sub MappeViaOutlookSenden2()
Const AN$ = "max.mustermann@gmx.at"
Const BETREFF$ = "Testdatei"
Const TEXT$ = "Im Anhang die aktuellen Untersuchungsergebnisse."
Const TYP$ = ".xlsx"
Const SEP$ = " "

Dim WbQ As Workbook: Set WbQ = ThisWorkbook
Dim Ol As Object, Eml As Object
Dim Pfad$, Anhang$

Pfad = WbQ.Path & "\"


Anhang = Pfad & Format(Now(), "YYYY-MM-DD_HH-MM_") & " " & Left(WbQ.Name, InStr(1, WbQ.Name, ".") - 1) & SEP & TYP
'WbQ.SaveCopyAs Anhang
WbQ.Save
kopie_speichern Anhang
Set Ol = CreateObject("Outlook.Application")
Set Eml = Ol.CreateItem(0)
With Eml
.To = AN
.Subject = BETREFF & " " & Date
.Attachments.Add Anhang
.Body = ANREDE & vbLf & vbLf & TEXT & vbLf & vbLf & GRUSS
.Display
End With
'Kill Anhang
Set Ol = Nothing
Set Eml = Nothing
End Sub

Sub kopie_speichern(Pfad As String)
Dim objFileDialog As FileDialog
Set objFileDialog = Application.FileDialog(msoFileDialogSaveAs)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
With objFileDialog
.FilterIndex = 1 '1 = .xlsx, 10 = .xltm
.InitialFileName = Pfad 'log_pfad & "\BA-Übersicht.xltm"
If .Show Then Call .Execute
End With
Application.DisplayAlerts = True

End Sub