Rename all files in a folder using excel vba

Question

我想用excel vba中的递增整数i替换下划线和前缀下划线之前的任何内容，以重命名文件夹中的所有文件。

Answer 1

Sub RenameFiles()
Const FolderLoc = "P:\yourfolder\"
Dim x As Long
x = 1
Dim s As String
s = Dir(FolderLoc & "*.*")
Do While s <> ""
    Name FolderLoc & s As FolderLoc & x & Right(s, Len(s) - (InStr(s, "_") - 1))
    s = Dir()
    x = x + 1
Loop
End Sub

Answer 2

'MACRO to Rename backed up files and place in order Sub Rename2()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object, abc As Object
Dim i As String
Dim s As String, dest As String

dest = "H:\Automation\outputs\"

Set objFSO = CreateObject("Scripting.FileSystemObject")
FolderLoc = dest


Set objFolder = objFSO.GetFolder(dest)
'MsgBox objFolder

i = 1
s = Dir(FolderLoc & "*.*")

On Error Resume Next

'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files

    Do While (InStr(s, "_")) > 0
        'MsgBox s
        'Name OldFile as NewFile

        Name FolderLoc & s As FolderLoc & i & "." & Right(s, Len(s) - (InStr(s, "_") + 2))
        s = i & "." & Right(s, Len(s) - (InStr(s, "_") + 2))
        'MsgBox s
        'abc = Name FolderLoc & s As FolderLoc & "(" & i & ")" & Right(s, Len(s) - (InStr(s, "@_@") + 2))
        'i = i + 1
    Loop
    i = i + 1
    s = Dir()

Next objFile

End Sub