【问题标题】:Make a new folder based on cell name and copy list of file into it [closed]根据单元名称创建一个新文件夹并将文件列表复制到其中[关闭]
【发布时间】:2021-01-01 00:14:03
【问题描述】:

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

我有一个带有 .pdf 扩展名的文档列表(在 A1:A20 列中)。我想将所有文档从源文件夹(在我的磁盘 C:)复制到目标文件夹(在磁盘 D:)。目标文件夹是一个以单元格值命名的新文件夹(另一张纸上的 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

【问题讨论】:

  • 您尝试过什么来实现这一目标?此外,显示您的工作表的屏幕截图确实会有所帮助。可能值得一读this
  • 当你说 _ 任何人都可以帮助我吗?_ 你到底在问什么?您是在寻求一般指导,还是要求有人为您编写代码?
  • 大家好,感谢您的回复。我问是否有人可以帮助我编写代码。我现在已经知道如何复制文件列表,但不知道如何创建基于单元格值命名的新文件夹并将其设置为目标文件夹。

标签: excel vba directory copy


【解决方案1】:

您可以尝试以下方法:

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

【讨论】:

  • 我假设您在 excel 表的 B 列中有文件夹名称
猜你喜欢
  • 2018-05-27
  • 1970-01-01
  • 1970-01-01
  • 2015-12-04
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2020-06-18
  • 1970-01-01
相关资源
最近更新 更多