将文档从一个文件夹移动到另一个文件夹

时间:2021-03-09 17:13:14

标签: vba

我希望将 Word 文档列表从一个文件夹移动到另一个文件夹。我有确切名称的列表。我在此处的其他答案之一中找到了 VBA 代码,但使用该代码,我一次只能移动所有 .doc 文件或一个命名文件。知道如何列出要在代码中移动的文件的名称吗?提前致谢!

Sub MoveFiles()

Dim sourceFolderPath As String, destinationFolderPath As String
Dim FSO As Object, sourceFolder As Object, file As Object
Dim fileName As String, sourceFilePath As String, destinationFilePath As String

Application.ScreenUpdating = False

sourceFolderPath = "C:\Users\Desktop\Test move"
destinationFolderPath = "C:\Users\\Desktop\Test"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set sourceFolder = FSO.Getfolder(sourceFolderPath)

For Each file In sourceFolder.Files
    fileName = file.Name
    If InStr(fileName, ".DOC") Then ' Only doc files will be moved
        sourceFilePath = file.Path
        destinationFilePath = destinationFolderPath & "\" & fileName
        FSO.MoveFile Source:=sourceFilePath, Destination:=destinationFilePath
    End If ' If InStr(sourceFileName, ".DOC") Then' Only doc files will be moved
Next

'Don't need set file to nothing because it is initialized in for each loop 
'and after this loop is automatically set to Nothing
Set sourceFolder = Nothing
Set FSO = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

您可以使用 Match 根据您的列表测试文件名:

Sub MoveFiles()

    Dim sourceFolderPath As String, destinationFolderPath As String
    Dim FSO As Object,  file As Object
    Dim fileName As String, rngFiles As Range

    'Adjust this line to point to wherever your list of files is...
    Set rngFiles = Thisworkbook.Worksheets("Files").Range("A1:A10") 
    
    sourceFolderPath = "C:\Users\Desktop\Test move"
    destinationFolderPath = "C:\Users\Desktop\Test\" 'tw added \ here
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For Each file In FSO.Getfolder(sourceFolderPath).Files
        fileName = file.Name
        'is the file name found in your list of files?
        If Not IsError(Application.Match(fileName, rngFiles, 0)) Then 
            file.Move destinationFolderPath 'simpler move...
        End If 
    Next
    
End Sub

也稍微简化了代码。