in einem Verzeichnis stehen sehr viele Excel und Word- Dateien mit sehr langen Dateinamen. Ich möchte nun mittels VBA alle Dateinamen auf 8 Stellen kürzen.
Hat jemand eine Idee?
Gruß
Sonja
Sub kürzen()
Shell ("c:\excelword\name.bat")
End Sub
Sub kürzen()
Close
Open "c:\excelword\name.bat" For Output As #1
Print #1, "rename *.xls ?.xls"
Print #1, "rename *.doc ?.doc"
Close
Shell ("c:\excelword\name.bat")
End Sub
dir c:\*.xls /b/s/-p > tools.txt
Und bei Win XP klappt dieses auch nicht? Ich habe jett nur die Doshilfe zu 98 als Datei hier, nicht die von XP, kann also nichts nachvollziehen warum es dort nicht geht.
Gruß
Reinhard
Sub Rename_Files()
Dim tmpName As String, tarName As String, tarPath As String
Dim myFSO As Object, myFld As Object, myFldFiles As Object, myFile As Object
Dim docCounter As Integer, xlsCounter As Integer, renCounter As Integer
Dim i As Integer, fileCount As Integer
Dim myErr As Integer
On Error GoTo myErrorHandler
'Erstellen des FileSystemObjectes
Set myFSO = CreateObject("Scripting.FileSystemObject")
tarPath = InputBox("Bitte Verzeichnis angeben, indem die Daten umebeannt werden sollen", "Rename Action", "C:\DemoVerz")
If Not myFSO.folderexists(tarPath) Then
MsgBox "Der Ordner :"" " & tarPath & " "" existiert nicht.", vbCritical + vbOKOnly, "Abbruch"
Exit Sub
End If
docCounter = 0
xlsCounter = 0
renCounter = 0
myErr = 1
'Name schleife starten
Set myFld = myFSO.GetFolder(tarPath)
Set myFldFiles = myFld.Files
'Tage ab wann gelöscht werden soll
For Each myFile In myFldFiles
tmpName = myFile.Name
If Right(tmpName, 3) = "doc" Then
tarName = Left(tmpName, 8) & ".doc"
ElseIf Right(tmpName, 3) = "xls" Then
tarName = Left(tmpName, 8) & ".xls"
End If
NameRestart:
myFile.Name = tarName
renCounter = renCounter + 1
Next
MsgBox "Es wurden " & renCounter & " Dateien umbenannt"
'Fehlerbehandlung Ende
myErrorExit:
Exit Sub
'Fehlerbehandlung starten
myErrorHandler:
Select Case Err
Case 58
If Right(tmpName, 3) = "doc" Then
tarName = Left(tarName, 7) & docCounter & ".doc"
docCounter = docCounter + 1
ElseIf Right(tmpName, 3) = "xls" Then
tarName = Left(tarName, 7) & xlsCounter & ".xls"
xlsCounter = xlsCounter + 1
End If
Resume NameRestart
Case Else
MsgBox Err.Number & ": " & Err.Description, vbCritical + vbOKOnly, "Unerwarteter Fehler > Abbruch Rename Action"
Resume myErrorExit
End Select
End Sub