[已解决]VBA同时导入多个文件夹内的文件

sure · 发表于 2016-5-10 11:14

各位老师好，我有多个文件夹，希望写个VBA代码，同时把多个文件夹下的文件都导入到excel里面去，文件夹路径不定，但是所有文件夹都放在同一路径下。且每个文件夹内文件的格式都是相同的，每个文件夹名就是系列名，每个文件夹内的文件命名：系列名+测试序列号；
生成的数据格式可以参见附件demo中的data sheet， Row 1 是每个文件夹内文件的系列名和测试序列号，在导入文件时提取出来并填充到单元格，每2列对应一个文件内的数据。
最好可以做成以下的形式，参见附件中的“打开格式”，直接选取要打开的文件夹（不是文件），然后导入即可。
这个对话框我只会做选取文件然后导入，不会做直接选取文件夹导入，比较头疼。

最佳答案

月排行榜 / 总排行榜

grf1973

2016-5-10 15:58

选择到所有有数据子文件夹的上一级文件夹。不可直接选择子文件夹。

'****获取本文件夹所有子文件夹下所有文件名
Sub test()
Dim sh As Worksheet, wb As Workbook
Set sh = ActiveSheet
sh.Cells.Clear
Set fso = CreateObject("scripting.filesystemobject")
fp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path & ""
Set ff = fso.getfolder(fp)
For Each fff In ff.subfolders
k = 0
For Each f In fff.Files
Set wb = Workbooks.Open(f)
k = k + 1
j = j + 2
sh.Cells(1, j - 1) = fff.Name
sh.Cells(1, j) = k
wb.Worksheets(1).UsedRange.Copy sh.Cells(2, j - 1)
ActiveWorkbook.Close False
Next
Next
sh.Columns.AutoFit
End Sub

复制代码

跳转到最佳答案楼层

橘子红 · 发表于 2016-5-10 11:32

选择的文件夹下还有没有文件夹

sure · 发表于 2016-5-10 12:04

橘子红发表于 2016-5-10 11:32
选择的文件夹下还有没有文件夹

没有，直接是文件

sure · 发表于 2016-5-10 13:36

请大神帮忙看一下，不知道怎么直接选取文件夹导入，而不是选取文件导入。

grf1973 · 发表于 2016-5-10 14:10

'****获取本文件夹所有子文件夹下所有文件名
Sub test()
Dim sh As Worksheet, wb As Workbook
Set sh = ActiveSheet
sh.Cells.Clear
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder(ThisWorkbook.Path)
For Each fff In ff.subfolders
k = 0
For Each f In fff.Files
Set wb = Workbooks.Open(f)
k = k + 1
j = j + 2
sh.Cells(1, j - 1) = fff.Name
sh.Cells(1, j) = k
wb.Worksheets(1).UsedRange.Copy sh.Cells(2, j - 1)
ActiveWorkbook.Close False
Next
Next
sh.Columns.AutoFit
End Sub

复制代码

sure · 发表于 2016-5-10 15:03

grf1973 发表于 2016-5-10 14:10

老师，你好，你的这个代码是需要脚本和文件夹在同一个目录下面，run才可以，如果脚本和文件夹不在一起，run就会出错。我希望的是点击activeX控件，弹出对话框，再选择多个文件夹导入，不知可能做如此修改？

grf1973 · 发表于 2016-5-10 15:58

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

选择到所有有数据子文件夹的上一级文件夹。不可直接选择子文件夹。

'****获取本文件夹所有子文件夹下所有文件名
Sub test()
Dim sh As Worksheet, wb As Workbook
Set sh = ActiveSheet
sh.Cells.Clear
Set fso = CreateObject("scripting.filesystemobject")
fp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path & ""
Set ff = fso.getfolder(fp)
For Each fff In ff.subfolders
k = 0
For Each f In fff.Files
Set wb = Workbooks.Open(f)
k = k + 1
j = j + 2
sh.Cells(1, j - 1) = fff.Name
sh.Cells(1, j) = k
wb.Worksheets(1).UsedRange.Copy sh.Cells(2, j - 1)
ActiveWorkbook.Close False
Next
Next
sh.Columns.AutoFit
End Sub

复制代码

sure · 发表于 2016-5-10 16:24

grf1973 发表于 2016-5-10 15:58
选择到所有有数据子文件夹的上一级文件夹。不可直接选择子文件夹。

谢谢，老师，这样已经很好了，主要不想直接导入文件，因为导入后还得对文件进行排序，按文件夹导入，就省了不少步骤。

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

[已解决]VBA同时导入多个文件夹内的文件

相关帖子