Dateien umwandeln
14.03.2016 10:35:42
Stefan
Hallo,
letzte Woche wurde meine unbeantworte Frage ins Archiv geschoben, deshalb nochmal ein neuer Beitrag.
https://www.herber.de/forum/archiv/1480to1484/t1480394.htm
Ich möchte eine ganze Reihe (ich glaube um die 50) Dateien so umbenennen, dass sie ohne VBA sind. Dafür wollte ich eine neue Datei erstellen und diesen Code im selben Ordner starten.
Es funktioniert mit meinen 5 Testdateien, nur dass er bei jeder Datei nochmal hinweist, dass ein Speichern unter .xlsx den VBA-Code löscht.
Wie entferne ich diese Meldung?
Sub umbenennen()
Dim fs As Object
Dim fVerz As Object
Dim fDatei As Object
Dim fDateien As Object
Dim StatusCalc As Long
Dim DateiName As String
Dim wkbAktuell As Object
Set fs = CreateObject("scripting.filesystemobject")
Set fVerz = fs.getfolder(ThisWorkbook.Path)
Set fDateien = fVerz.Files
With Application
.EnableEvents = False
.DisplayAlerts = False
' .ScreenUpdating = false
' StatusCalc = .Calculation
' .Calculation = xlCalculationManual
End With
Debug.Print Application.DisplayAlerts
Debug.Print Application.EnableEvents
For Each fDatei In fDateien
If InStr(fDatei, "") > 0 And Not Right(fDatei.Name, 15) = "umbenennen.xlsm" Then 'hier gibt _
_
_
es sicher eine elegantere Lösung,
'um nicht _
_
_
die eigene Datei zu löschen
Set wkbAktuell = Excel.Application.Workbooks.Open(fDatei)
DateiName = fDatei.Name
DateiName = Left(DateiName, InStrRev(DateiName, ".") - 1)
wkbAktuell.SaveAs fVerz & "/" & DateiName, FileFormat:=51
wkbAktuell.Close
'fDatei.Delete
End If
Next fDatei
With Application
.EnableEvents = True
.DisplayAlerts = True
' .ScreenUpdating = True
' .Calculation = StatusCalc
End With
MsgBox "ende"
End Sub