根据单元格名称创建一个新文件夹并将文件列表复制到其中

Question

我是 VBA excel 的新人。想问问大家

我有一个扩展名为 .pdf 的文档列表（在 A1:A20 列中）。我想将所有文件从源文件夹（在我的磁盘 C: 中）复制到目标文件夹（在磁盘 D: 中）。目标文件夹是一个按单元格值命名的新文件夹（其他 sheet 上的 B1）。

'This code for copy files from the document list
 Sub copyfiles()

 Const sourcePath As String = "C:\Users\"  'source folder
 Const DestPath As String = "D:\Users\" 'how to change it with new folder that named is from cell B1 'destination folder
 Const ListAddress As String = "A1:A20"  'document list

' Write file list to array.
 Dim FileList As Variant: FileList = Sheet4.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

我尝试使用此代码基于单元格值创建新文件夹，但我不知道如何将它与目标文件夹连接。

Dim startPath As String
Dim myName As String
startPath = "H:\Users\"
myName = ThisWorkbook.Sheets("Cover Page").Range("B1").Text      
If myName = vbNullString Then myName = "Nuovo"
Dim folderPathWithName As String
folderPathWithName = startPath & Application.PathSeparator & myName
If Dir(folderPathWithName, vbDirectory) = vbNullString Then
MkDir folderPathWithName
Else
MsgBox "Folder already exists"
Exit Sub
End

这里有没有人可以帮我提供连接代码？在此先感谢您的帮助。

对于阅读此主题并且可能有相同问题的您，我已经解决了这个问题。我更改此代码：

 Const sourcePath As String = "C:\Users\"  'source folder
 Const DestPath As String = "D:\Users\" 'how to change it with new folder that named is from cell B1 'destination folder
 Const ListAddress As String = "A1:A20"  'document list

使用此代码

 sourcePath = "C:\Users\"  'source folder
 DestPath = "D:\Users\" ThisWorkbook.Sheets("Cover Page").Range("B1").Value  'This is the destination folder with the name from cell B1, sheet "Front Page"
 ListAddress = "A1:A20"  'document list

 On Error Resume Next
 MkDir (DestPath)     'To create the destination folder

Answer 1

您可以尝试以下操作：

DestPath = "D:\" & Cells(i, 2).Value & "\"
On Error Resume Next
MkDir (DestPath)
FileCopy sourcePath & FName, DestPath & FName

根据单元格名称创建一个新文件夹并将文件列表复制到其中

Make a new folder based on cell name and copy list of file into it

directory

excel

vba

copy