使用 VBA 将文件从一个文件夹移动到另一个文件夹

Question

我有一个代码可以将 Excel 文件从一个文件夹传输到另一个文件夹，但我想更新代码以便它可以移动所有文件（.xml,.txt,.Z437175BA4191210EE004E1D934）

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 = "E:\Source"
    destinationFolderPath = "E:\Destination"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set sourceFolder = FSO.GetFolder(sourceFolderPath)
    
    For Each file In sourceFolder.Files
    
        fileName = file.Name
    
        If InStr(fileName, ".xlsx") Then ' Only xlsx files will be moved
    
            sourceFilePath = file.Path
            destinationFilePath = destinationFolderPath & "\" & fileName
            FSO.MoveFile Source:=sourceFilePath, Destination:=destinationFilePath
    
        End If ' If InStr(sourceFileName, ".xlsx") Then' Only xlsx 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


can you please help

Answer 1

使用MoveFile移动文件

• 您可以通过使用CopyFile和DeleteFile而不是MoveFile来更好地控制事物。
• 使用Dir 、 FileCopy和Kill ，而不是FileSystemObject object 及其方法，将使其更简单，也更快。

Option Explicit

Sub MoveFilesTEST()

    Const sFolderPath As String = "E:\Source"
    Const dFolderPath As String = "E:\Destination"
    Const FilePattern As String = "*.*"
    
    MoveFiles sFolderPath, dFolderPath, FilePattern

End Sub

Sub MoveFiles( _
        ByVal SourceFolderPath As String, _
        ByVal DestinationFolderPath As String, _
        Optional ByVal FilePattern As String = "*.*")
    
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Not fso.FolderExists(SourceFolderPath) Then
        MsgBox "The source folder path '" & SourceFolderPath _
            & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    If Not fso.FolderExists(DestinationFolderPath) Then
        MsgBox "The destination folder path '" & DestinationFolderPath _
            & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    Dim apSep As String: apSep = Application.PathSeparator
    
    Dim sPath As String: sPath = SourceFolderPath
    If Left(sPath, 1) <> apSep Then sPath = sPath & apSep
        
    Dim sFolder As Object: Set sFolder = fso.GetFolder(sPath)
    If sFolder.Files.Count = 0 Then
        MsgBox "There are no files in the source folder '" & sPath & "'.", _
            vbExclamation
        Exit Sub
    End If
    
    Dim dPath As String: dPath = DestinationFolderPath
    If Left(dPath, 1) <> apSep Then dPath = dPath & apSep
        
    Dim dFolder As Object: Set dFolder = fso.GetFolder(dPath)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sFile As Object
    Dim dFilePath As String
    Dim ErrNum As Long
    Dim MovedCount As Long
    Dim NotMovedCount As Long
    
    For Each sFile In sFolder.Files
        dFilePath = dPath & sFile.Name
        If fso.FileExists(dFilePath) Then
            dict(sFile.Path) = Empty
            NotMovedCount = NotMovedCount + 1
        Else
            On Error Resume Next
                fso.MoveFile sFile.Path, dFilePath
                ErrNum = Err.Number
                ' e.g. 'Run-time error '70': Permission denied' e.g.
                ' when the file is open in Excel
            On Error GoTo 0
            If ErrNum = 0 Then
                MovedCount = MovedCount + 1
            Else
                dict(sFile.Path) = Empty
                NotMovedCount = NotMovedCount + 1
            End If
        End If
    Next sFile
    
    Dim Msg As String
    Msg = "Files moved: " & MovedCount & "(" & NotMovedCount + MovedCount & ")"
    If NotMovedCount > 0 Then
        Msg = Msg & vbLf & "Files not moved:" & NotMovedCount & "(" _
            & NotMovedCount + MovedCount & ")" & vbLf & vbLf _
            & "The following files were not moved:" & vbLf _
            & Join(dict.keys, vbLf)
    End If
    
    MsgBox Msg, IIf(NotMovedCount = 0, vbInformation, vbCritical)
 
End Sub