根据A列文件名将文件夹下文件复制到指定文件夹

tangwei94054 · 发表于 2018-4-22 23:35

如何根据excel表中的A列中列出的n个文件名(文件名有可能是全名带后缀，有可能是关键字不带后缀)，在指定目录下的所有文件比如D:\123\（指定文件夹下还有子目录），找到表格中A列对应的文件名，然后复制到指定文件夹中，如D:\234\请问怎么才能达到啊？

有一点小要求，指定目录可以用按钮来选择，文件复制完成后在C1显示复制结果，完成了多少个，没有找到的文件的文件名在B列显示出来。

tangwei94054 · 发表于 2018-4-23 08:54

好像这个要牵涉到历遍文件等，小弟对VBA不是太熟悉。希望得老师帮助，在此深表感谢！

opiona · 发表于 2018-4-23 10:28

新建文件夹.rar (22.7 KB, 下载次数: 257)

QQ截图20180423102822.jpg

opiona · 发表于 2018-4-23 10:33

Set SHX = Worksheets("Sheet1")
SHX.Range("B2:B65536").ClearContents
Rem 选择文件夹
Path = GetDirName
Rem 创建结果文件夹
PATHG = ThisWorkbook.Path & "\结果"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(PATHG) = True Then
FSO.GetFolder(PATHG).Delete '//删除文件夹
End If
MkDir PATHG '//创建文件夹
Rem 遍历文件名
For IROW = 2 To SHX.Range("A65536").End(3).Row
Rem 获取文件列表
FileArr = FileAllArr(Path, "*" & SHX.Cells(IROW, 1).Value & "*", ThisWorkbook.Name, True, False)
If FileArr(0) <> "" Then
For I = 0 To UBound(FileArr)
OldName = FileArr(I)
Rem 为防止重名文件被替换，加上：数字
If Len(SHX.Cells(IROW, 2).Value) = 0 Then X = 0 Else X = SHX.Cells(IROW, 2).Value
Rem 目标文件夹+文件名+扩展名,
NEWNAME = PATHG & "" & Format(X, "0000") & "_" & GetPathFromFileName(FileArr(I), True)
FileCopy OldName, NEWNAME '//复制文件，比好FileCopy用
SHX.Cells(IROW, 2).Value = SHX.Cells(IROW, 2).Value + 1
Next
Else
SHX.Cells(IROW, 2).Value = "没有"
End If
Next

复制代码

tangwei94054 · 发表于 2018-4-23 16:12

opiona 发表于 2018-4-23 10:33

谢谢大侠。好像我试了一下文件找不到啊，还有他不能自动选择源文件夹。只能选择存放文件夹。如果能在A列需要复制的文件后面跟一个yes 。没有找到的跟一个NO就方便了。

tangwei94054 · 发表于 2018-4-23 16:13

opiona 发表于 2018-4-23 10:28

我试了一下，不能选择源文件夹。然后很多文件都找不到啊。是怎么回事

opiona · 发表于 2018-4-23 16:19

tangwei94054 发表于 2018-4-23 16:12
谢谢大侠。好像我试了一下文件找不到啊，还有他不能自动选择源文件夹。只能选择存放文件夹。如果能在A列 ...

指定源文件夹

opiona · 发表于 2018-4-23 16:20

tangwei94054 发表于 2018-4-23 16:13
我试了一下，不能选择源文件夹。然后很多文件都找不到啊。是怎么回事

没有附件一切只能随缘了！

tangwei94054 · 发表于 2018-4-23 17:45

我把附件发上来了。麻烦大侠指导一下

opiona · 发表于 2018-4-24 09:50

没发现什么问题啊
执行结果：
QQ截图20180424094932.jpg

		自动登录	找回密码
密码			免费注册

[求助] 根据A列文件名将文件夹下文件复制到指定文件夹

评分