重命名文件夹中的所有文件，添加变量值而不打开

Question

我根据一年中的月份(例如，01、02、03(按地区在子文件夹中有大量 *.xlsx 文件。 我想遍历每个文件，并将与子文件夹关联的句点附加到每个文件名的末尾。 例如，亚特兰大01鲍勃琼斯.xlsx将成为亚特兰大01鲍勃琼斯01.xlsx。 我看过这个论坛和其他地方的例子，找不到足够相似的东西来做我想做的事。 任何帮助将不胜感激！

这是我到目前为止所拥有的：

Sub DSMReports1()
Dim MM As String
MM = InputBox("Enter Month for reporting in MM format: 01-12", , Range("C6").Value)
Range("C6").Value = MM
Application.DisplayAlerts = False
Dim DistrictDSM As String
Dim Path As String
Dim DistPeriodFileOld As String
Dim DistPeriodFileNew As String
Dim Total As Integer
Dim Period As Integer
DistrictDSM = Range("B3").Value 'Selected from a dropdown list
Path = "H:AccountingMonthend 2018DSM Files" & DistrictDSM & "P" & MM & ""
DistPeriodFileOld = Dir(Path & "*.xlsx")
DistPeriodFileNew = Dir(Path & "*.xlsx") 'This is where I'd like to append the period value found in MM
Do While DistPeriodFileOld <> ""
Name DistPeriodFileOld As DistPeriodFileNew
DistPeriodFileOld = Dir
Loop
Next DistrictDSM
End Sub

Answer 1

如果你有大量的*.xlsx，我相信这段代码可以帮助你。

Sub ReadAllFiles(ByVal s As String)
'Remember: Add Reference Microsoft Scripting Runtime
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim myFile As File
Set myFolder = FSO.GetFolder(s)
For Each myFile In myFolder.Files
If UCase(Mid$(myFile.Name, Len(myFile.Name) - 3, 4)) = ".XLS" Or UCase(Mid$(myFile.Name, Len(myFile.Name) - 3, 4)) = "XLSX" Then
Debug.Print "readind file " & myFile.Path
End If
Next
End Sub

之后，您需要将旧名称替换为新名称。

Function RenameFiles(p_file As String) As String
'Atlanta 01 Bob Jones.xlsx
Dim v_name As String
Dim v_extension As String
If UCase(Mid$(p_file, Len(p_file) - 3, 4)) = ".XLS" Then
v_name = Mid$(p_file, 1, Len(p_file) - 4) 'Atlanta 01 Bob Jones
v_extension = Mid$(p_file, Len(p_file) - 2, 4) '.xls
End If
If UCase(Mid$(p_file, Len(p_file) - 3, 4)) = "XLSX" Then
v_name = Mid$(p_file, 1, Len(p_file) - 5) 'Atlanta 01 Bob Jones
v_extension = Mid$(p_file, Len(p_file) - 3, 4) '.xls
End If
RenameFiles = v_name & " 01" & "." & v_extension 'warning --> I fixed 01 here
End Function

最后：

Sub ReadAllFiles(ByVal s As String)
'Remember: Add Reference Microsoft Scripting Runtime
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim myFile As File
Set myFolder = FSO.GetFolder(s)
For Each myFile In myFolder.Files
If UCase(Mid$(myFile.Name, Len(myFile.Name) - 3, 4)) = ".XLS" Or UCase(Mid$(myFile.Name, Len(myFile.Name) - 3, 4)) = "XLSX" Then
Debug.Print "reading file " & myFile.Path
FileCopy myFile.Path, RenameFiles(myFile.Path) 'Here we COPY original file to new file
End If
Next
End Sub

我希望我能帮助你。