Makro Excel per Mail versenden und dabei xlsm zu xlsx

Hallo liebe Forumsteilnehmer:innen,
heute habe ich wieder eine Spezialfrage, zu der ich seit Stunden einfach keine Lösung finde.
Und zwar muss ich täglich eine xlsm-Datei per Mail an viele Empfänger versenden (Empfänger lesen Großteils nur noch; Bearbeitung höchstens für Diagramme). Einige Empfänger können keine Dateien mit Makros öffnen und benötigen die Datei als xlsx.
Nach vielen Versuchen habe ich im Internet einen Code gefunden, der fast funktioniert (es funktioniert fast alles, nur die Datei lässt sich aufgrund des Versandformates "xlsx" bei ursprünglich "xlsm") nicht öffnen. Wenn ich im Code wie ursprünglich "xlsm" einschreibe, funktionierts.... nur dann das Problem auf der Empfängerseit.
Frage: kann ich in den Code irgendetwas einfügen (automatisches Konvertieren im Versand?) um diese "Ecke" zu lösen? Wichtig: die Ursprungsdatei muss xlsm bleiben.
verwendeter Code unterbei

Für eine Hilfe wäre ich sehr dankbar!
Lg, Martina

Sub MappeViaOutlookSenden()
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 Suf$, Pfad$, Anhang$
Pfad = WbQ.Path & "\"
Suf = Application.InputBox("Dateinamen-Zusatz eingeben:", _
"Dateiname Email-Anhang ", , , , , , 2 + 4)
Select Case Suf
Case Is = vbNullString: Exit Sub
Case Is = False: Exit Sub
End Select
Anhang = Pfad & Left(WbQ.Name, InStr(1, WbQ.Name, ".") - 1) & SEP & Suf & TYP
WbQ.SaveCopyAs 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Martina!

Ich hab die Erfahrung gemacht, dass eine xlsm oder xltm sich nach "savecopyas" nicht als xls oder xlsx öffnen lässt. Daher musst du die Methode ändern.

"saveas" speichert sie korrekt ab. Allerdings ist das dann auch die Datei, die nach Ablauf deines Makros geöffnet ist.
Daher musst du auf das sofortige löschen der Datei verzichten (da sie ja zur Laufzeit des Makros geöffnet ist). Außerdem wäre es ratsam, vor dem "kopie_Speichern" noch einmal deine Originaldatei zu speichern, damit beim nächsten öffnen auch der aktuelle Stand noch da ist.

Mit diesen Baustellen im Sinn stell ich dir folgenden Code zur Verfügung:

Sub MappeViaOutlookSenden()

    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 Suf$, Pfad$, Anhang$

    

    Pfad = WbQ.Path & "\"

    Suf = Application.InputBox("Dateinamen-Zusatz eingeben:", "Dateiname Email-Anhang ", , , , , , 2 + 4)

    

    Select Case Suf

        Case Is = vbNullString: Exit Sub

        Case Is = False: Exit Sub

    End Select

    

    Anhang = Pfad & Left(WbQ.Name, InStr(1, WbQ.Name, ".") - 1) & SEP & Suf & 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

Gruß, MCO

Beliebteste Forumthreads (12 Monate)

Makro Excel per Mail versenden und dabei xlsm zu xlsx

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro Excel per Mail versenden und dabei xlsm zu xlsx

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread