Question

根据地区的年份月份（例如01、02、03），我在子文件夹中有大量* .xlsx文件。我想遍历每个文件，并将与子文件夹关联的句点附加到每个文件名的末尾。例如， Atlanta 01 Bob Jones.xlsx 将变为 Atlanta 01 Bob Jones 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:\Accounting\Monthend 2018\DSM 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

希望我能对您有所帮助。

重命名文件夹中所有文件并添加变量值而无需打开

1 个答案: