lese zwar schon seit einiger Zeit mit um meine Probleme zu lösen. Leider kann ich mein jetziges Problem nicht alleine lösen.
Ich benutze in eine Excel Datei ein VBA code, der einmal meine Datei unter einem bestimmten Pfad und unter einem bestimmten Dateinamen speichert. Der Dateiname setzt sich aus mehreren Zellen des ersten Blatts zusammen. Dieser Teil funktioniert auch ohne probleme.
Im zweiten Schritt sollen nun nochmal alle Arbeitsblätter sparat abgespeicheret werden. Dieser schritt erzeugt neuerdings leider keine .xls sondern eine .x Datei. Die Datei ist vollkommen wertlos.
Habe es mit verschiedenen Dateien versucht. Immer das gleiche Ergebnis. Habe den Speicherort geändert, wieder Fehlanzeige. Bis vor wenigen Tagen hat es noch funktioniert.
Habe auch schon versucht im zweiten Teil das Dateiformat expliziet festzulegen. Ohne Erfolg
Danke für eure Hilfe.
Public Sub Speichern()
Dim strPath As String, strFile As String
strFile = Range("d7").Text & " _" & Range("d3").Text & "_" & Range("d5").Text & "_Rev_" & _
Range("e3").Text
strPath = "C:\Users\hrs33\Desktop\Maintenance Plan Checklist\" & Cells(3, 4).Text & "\" & _
Cells(7, 4).Text & "_" & Cells(3, 4).Text & "_" & Cells(5, 4).Text & "\"
If CBool(MakeSureDirectoryPathExists(strPath)) Then
ThisWorkbook.SaveAs Filename:=strPath & strFile, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled
Else
MsgBox "Fehler beim anlegen des Pfades: " & strPath
End If
End Sub
Sub alle_Tab_als_Datei()
Dim neuname As String
Dim i As Integer
Application.ScreenUpdating = False
For i = 2 To ActiveWorkbook.Worksheets.Count
neuname = "C:\Users\hrs33\Desktop\Maintenance Plan Checklist\" & Cells(3, 4).Text & "\" & _
Cells(7, 4).Text & "_" & Cells(3, 4).Text & "_" & Cells(5, 4).Text & "\" & Sheets("Summary").Range("d7").Text & "_" & Sheets("Summary").Range("d3").Text & "_" & Sheets("summary").Range("d5").Text & "_" & Sheets(i).Name & "_Rev_" & Sheets("Summary").Range("e3")
If Worksheets(i).Visible = True Then
Sheets(i).Copy
ActiveWorkbook.SaveAs neuname
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True
End Sub
Sub alles_speichern()
Call screen_update_off
Call schutz_aufheben
Call Speichern
Call alle_Tab_als_Datei
Call schutz
Call screen_update_on
End Sub