bin am Verzweifeln. Versuche schon seit Stunden hinzubekommen eine xlsm-Datei als xlsx-Datei zu speichern OHNE ausführbare Makros. Die Datei wird auch als xlsx-Datei gespeichert und als Anhang in meine Outlook-Mail gehangen, allerdings kann ich trotzdem die Makros (die ich einer elliptischen Form zugewiesen habe) ausführen.
Auffällig ist das die Makros wohl auf die ursprüngliche xlsm-Datei zu greifen, denn diese Datei (xlsm) wird automatisch beim Ausführen geöffnet.
Was auch noch auffällig ist, das ich beim Speichern als xlsx keine Hinweismeldung bekomme, das die Makros dann nicht mehr ausführbar sind.
Ich hoffe das jemand den Haken an meinem Code sieht. Ich sehe ihn definitiv nicht :(
Danke und Gruß
Walter
Sub BlattSenden()
'** Das aktive Tabellenblatt wird über Outlook versendet
'** Dimensionierung der Variablen
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Dim strMaschTyp As String
Dim Datum As Date
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
strMaschTyp = "Palettierer"
Datum = Date
'** Pfad für temporäre Zwischenspeicherung angeben
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name & "_" & strMaschTyp & "_" & Datum & ". _
xlsx", FileFormat:=xlOpenXMLWorkbook
'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName
'** Body-Text festlegen
strBodyText = _
"TEXT" & vbCr & vbCr & "Mit freundlichen Grüßen"
'** Mail erzeugen
With Mail
.To = ""
.CC = ""
.Subject = "UPDATE - Kostentabelle " & strMaschTyp & " " & Datum 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
'** Erzeugte Datei wieder löschen
Kill (strDatei)
'** E-Mail anzeigen
Mail.Display
End Sub