将文件从 excel 列表复制到其他文件夹的扩展名
copy file from excel list with extension to other folder
我是 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.", vbInformation, "Success"
End Select
End Sub
我是 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.", vbInformation, "Success"
End Select
End Sub