将具有扩展名的Excel列表中的文件复制到其他文件夹

如何解决将具有扩展名的Excel列表中的文件复制到其他文件夹

我是VBA的新手，所以我在excel列中有一个文档列表（扩展名为.pdf，.docx等）。我想做的就是将列表中的所有文档从源文件夹复制到目标文件夹。

我已经尝试了一些代码，但是它可以复制文件夹中的所有文件而不是列表中的文件（文档列表仅在B3：B10中）。

任何帮助都很感激。

谢谢。

Sub copyfile()

Dim r As Range
Dim Jajal As Range
Dim sourcePath As String,DestPath As String,FName As String

sourcePath = "C:\Users\"
DestPath = "H:\Users\"

For Each r In Range(Sheet6.Range("B3"),Sheet6.Range("B10")) 'the list document is in the sheet6 B3:B10
FName = Dir(sourcePath & r)
'Loop while files found
do while FName <> ""
  'copy the file
  Filecopy sourcePath & FName,DestPath & FName
  'Search the next file
  FName = Dir()
Loop
Next


End Sub

解决方法

使用Dir循环浏览目录中的所有文件。如果您知道自己的文件，则不需要Dir。请尝试以下操作（未经测试）：

Sub copyfile()

    Dim r As Range
    Dim Jajal As Range
    Dim sourcePath As String,DestPath As String

    sourcePath = "C:\Users\"
    DestPath = "H:\Users\"

    For Each r In Range(Sheet6.Range("B3"),Sheet6.Range("B10")) 'the list document is in the sheet6 B3:B10
        'Loop while files found
        If r.Value <> ""
          'Copy the file
          FileCopy sourcePath & r.Value,DestPath & r.Value
          'Search the next file
        End If
    Next


End Sub

但是，您可以在复制之前测试文件是否存在。

,

从范围（列表）复制文件

代码

Option Explicit

' This will copy files found in a source path AND whose names
' are contained in a list (range),to a destination path,' overwriting possible existing files.

Sub copyFiles()
    
    Const SourcePath As String = "C:\Users\"
    Const DestPath As String = "H:\Users\"
    Const ListAddress As String = "B3:B10"
    
    ' Write file list to array.
    Dim FileList As Variant: FileList = Sheet1.Range(ListAddress).Value
    
    ' 'Get' first file name.
    Dim FName As String: FName = Dir(SourcePath)
    ' 'Initiate' counter.
    Dim i As Long
    ' Loop files in SourcePath.
    Do While FName <> ""
        ' Check if file name of current file is contained in array (FileList).
        If Not IsError(Application.Match(FName,FileList,0)) Then
            ' Count file.
            i = i + 1
            ' Copy file.
            FileCopy SourcePath & FName,DestPath & FName
        End If
        ' 'Get' next file name.
        FName = Dir()
    Loop
    
    ' Inform user.
    Select Case i
        Case 0: MsgBox "No files found",vbExclamation,"No Files"
        Case 1: MsgBox "Copied 1 file.",vbInformation,"Success"
        Case Else: MsgBox "Copied " & i & " files.","Success"
    End Select

End Sub