23.07.2018, 15:47
Hallo zusammen,
ich habe folgenden funktionieren Code in einer Testdatei zum Laufen gebracht. Wenn ich jetzt eine etwas größere Arbeitsdatei bei uns damit abspeichern will, dann sagt er mir " Erheblicher Funktionalitätsverlust". Im Endeffekt speichert er dann die datei ohne daten mit 0 KB...habt Ihr eine Idee woran es liegt?
Sub SPEICHERN()
'Datei und Pfad sind Wörter, die in VBA
'Verwendung finden und deshalb verboten
'sind
Dim sDatei As String, sZielDatei As String
Dim Pos
'Dim sPfad As String
'hier fehlt der Backslash (\)
'sPfad = ThisWorkbook.Path
sPfad = ActiveWorkbook.Path & "\"
sDatei = ActiveWorkbook.Name
'
'in Dateinamen sind z.B. Doppelpunkte
'nicht erlaubt
'Dateinamen extrahieren
Pos = InStrRev(sDatei, ".", , vbTextCompare)
sZielDatei = sPfad & Mid(sDatei, 1, Pos - 1)
sZielDatei = sZielDatei _
& "_" & Format(Date, "yyyyMMdd")
'MsgBox sZielDatei
'
ActiveWorkbook.SaveAs Filename:=sZielDatei & ".xlsm", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub
vg, die Kirsche
ich habe folgenden funktionieren Code in einer Testdatei zum Laufen gebracht. Wenn ich jetzt eine etwas größere Arbeitsdatei bei uns damit abspeichern will, dann sagt er mir " Erheblicher Funktionalitätsverlust". Im Endeffekt speichert er dann die datei ohne daten mit 0 KB...habt Ihr eine Idee woran es liegt?
Sub SPEICHERN()
'Datei und Pfad sind Wörter, die in VBA
'Verwendung finden und deshalb verboten
'sind
Dim sDatei As String, sZielDatei As String
Dim Pos
'Dim sPfad As String
'hier fehlt der Backslash (\)
'sPfad = ThisWorkbook.Path
sPfad = ActiveWorkbook.Path & "\"
sDatei = ActiveWorkbook.Name
'
'in Dateinamen sind z.B. Doppelpunkte
'nicht erlaubt
'Dateinamen extrahieren
Pos = InStrRev(sDatei, ".", , vbTextCompare)
sZielDatei = sPfad & Mid(sDatei, 1, Pos - 1)
sZielDatei = sZielDatei _
& "_" & Format(Date, "yyyyMMdd")
'MsgBox sZielDatei
'
ActiveWorkbook.SaveAs Filename:=sZielDatei & ".xlsm", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub
vg, die Kirsche