0

我已经修改了一个代码，它根据列重命名我的文件名。但是，有一个循环，程序正在更改同一文件的名称，直到出现错误。如何更改名称，将文件移动到另一个文件夹，然后处理下一个文件？下面是代码，重要部分用“----------”分隔

谢谢！

Option Explicit

Sub ListFiles()

'http://www.xl-central.com/list-the-files-in-a-folder-and-subfolders.html

Application.ScreenUpdating = False

'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables
Dim objFSO As Scripting.FileSystemObject
Dim objTopFolder As Scripting.Folder
Dim strTopFolderName As String

'Insert the headers for Columns A through F
Range("A1").Value = "File Name"
Range("B1").Value = "File Size"
Range("C1").Value = "File Type"
Range("D1").Value = "Date Created"
Range("E1").Value = "Date Last Accessed"
Range("F1").Value = "Date Last Modified"
Range("G1").Value = "Parent Folder"
Range("H1").Value = "Short Path"
Range("K1").Value = "New Name"

'Assign the top folder to a variable
strTopFolderName = "D:\"

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the top folder
Set objTopFolder = objFSO.GetFolder(strTopFolderName)

'Call the RecursiveFolder routine
Call RecursiveFolder(objTopFolder, True)

'Change the width of the columns to achieve the best fit
Columns.AutoFit


End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
IncludeSubFolders As Boolean)


'Declare the variables
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder
Dim NextRow As Long
Dim Sample As String

'Find the next available row
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

'Loop through each file in the folder
For Each objFile In objFolder.Files
    Cells(NextRow, "A").Value = objFile.Name
    Cells(NextRow, "B").Value = objFile.Size
    Cells(NextRow, "C").Value = objFile.Type
    Cells(NextRow, "D").Value = objFile.DateCreated
    Cells(NextRow, "E").Value = objFile.DateLastAccessed
    Cells(NextRow, "F").Value = objFile.DateLastModified
    Cells(NextRow, "G").Value = objFile.ParentFolder
    Cells(NextRow, "H").Value = objFile.ShortPath

  '-----------------------------
    'Comandos para copiar e colar as fórmulas que definirão o novo nome do arquivo
        Range("I1").Copy
            Range("I" & NextRow).PasteSpecial (xlPasteFormulas)
            Range("I" & NextRow).Calculate
                Range("J1").Copy
                    Range("J" & NextRow).PasteSpecial (xlPasteFormulas)
                    Range("J" & NextRow).Calculate

    Sample = Range("J" & NextRow).Value 'Nome da amostra

        objFile.Name = Sample & objFile.Name 'Mudança do nome do arquivo para incluir o nome da amostra

            Cells(NextRow, "K").Value = objFile.Name 'Inserção do novo nome do arquivo após alteração

  '----------------------------
    NextRow = NextRow + 1

Next objFile

'Loop through files in the subfolders
If IncludeSubFolders Then
    For Each objSubFolder In objFolder.SubFolders
        Call RecursiveFolder(objSubFolder, True)
    Next objSubFolder
End If

Application.ScreenUpdating = True


End Sub
4

1 回答 1

0

您正在从该循环内部修改循环的元素，这种方式可能会使您正在迭代其元素的对象无效（或刷新） - 在您的情况下，objFolder.Files 集合。

解决方案：在您的循环中，收集集合（数组或您喜欢的任何内容）中文件的旧名称和新名称，而不是直接重命名文件。然后，再次遍历您的新集合（而不是 objFolder.Files）并进行重命名。

于 2013-10-15T14:43:34.830 回答