如何解决根据单元名称创建新文件夹并将文件复制到其中
我想基于工作表(Sheet3(封面页)单元格B4)中的单元格值创建新文件夹,并使用此新文件夹,从列表中复制多个文档(Sheet4单元格B5:B30)从源文件夹到创建的文件夹。文档列表带有扩展名(.pdf,.docx等)。此外,我还想防止创建具有相同名称的文件夹。
此刻,我可以基于单元格创建新文件夹,也可以复制列表中的文档,但是不知道如何将这两项结合在一起。 任何帮助,将不胜感激。 预先感谢。
'This code is for create new folder based on cell value
Sub makenewfolder()
Dim startPath As String
Dim myName As String
startPath = "H:\Users\"
myName = ThisWorkbook.Sheets("Cover Page").Range("B4").Text
If myName = vbNullString Then myName = "Testing"
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 If
End Sub
'This code for copy files from the document list
Sub copyfiles()
Const sourcePath As String = "C:\Users\"
Const DestPath As String = "H:\User\"
Const ListAddress As String = "B5:B30"
' 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.","Success"
End Select
End Sub
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。