VBA遍历表并将文件从一个文件夹移动到另一个

Question

嗨，我对 Excel VBA 不是很有经验，但我想遍历一个表并将 jpeg 文件从当前位置复制到表数组中定义的新位置。 我尝试了一些预建的潜艇，但运气不佳。 任何人都可以提供帮助吗？

源和目的地表

Option Explicit

Sub CopyFiles()
    Dim iRow As Integer         ' ROW COUNTER.
    Dim sSourcePath As String
    Dim sDestinationPath As String
    Dim sFileType As String
    
    Dim bContinue As Boolean
    
    bContinue = True
    iRow = 2
    
    ' THE SOURCE AND DESTINATION FOLDER WITH PATH.
    sSourcePath = "C:\books\"
    sDestinationPath = "C:\booksforclient\"
    
    sFileType = ".jpg"      ' TRY WITH OTHER FILE TYPES LIKE ".pdf".
   
    ' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
    While bContinue
    
        If Len(Range("B" & CStr(iRow)).Value) = 0 Then    ' DO NOTHING IF THE COLUMN IS BLANK.
            MsgBox "Process executed" ' DONE.
            bContinue = False
        Else
            ' CHECK IF FILES EXISTS.
            
            If Len(Dir(sSourcePath & Range("B" & CStr(iRow)).Value & sFileType)) = 0 Then
                Range("C" & CStr(iRow)).Value = "Does Not Exists"
                Range("C" & CStr(iRow)).Font.Bold = True
            Else
                Range("C" & CStr(iRow)).Value = "On Hand"
                Range("C" & CStr(iRow)).Font.Bold = False
            
                If Trim(sDestinationPath) <> "" Then
                    Dim objFSO
                    Set objFSO = CreateObject("scripting.filesystemobject")
                    
                    ' CHECK IF DESTINATION FOLDER EXISTS.
                    If objFSO.FolderExists(sDestinationPath) = False Then
                        MsgBox sDestinationPath & " Does Not Exists"
                        Exit Sub
                    End If
                    
                    '*****
                    ' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
                    ' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE 
                    ' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.
                    
                    ' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
                    objFSO.CopyFile Source:=sSourcePath & Range("B" & CStr(iRow)).Value & _
                        sFileType, Destination:=sDestinationPath
                    
                    ' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
                    'objFSO.MoveFile Source:=sSourcePath & Range("B" & CStr(iRow)).Value & _
                        sFileType, Destination:=sDestinationPath
                    '*****
                End If
            End If
        End If
       
       iRow = iRow + 1      ' INCREMENT ROW COUNTER.
    Wend
End Sub

Answer 1

只需在表格中再添加一列，用公式填充它

="move /-Y """ &[@CurrentLocation]&""" """&[@Desination]&""""

选择结果并复制，打开记事本并粘贴。 保存为 BAT 文件并运行它。

（相信我，它比编写和调试宏花费的时间要少得多）