标题:批量提取文件夹名至EXCEL中的VBA代码
在实际工作中,有时需要把某个文件夹下的批量文件夹提取到EXCEL中,逐个粘贴夹名费时费力,写一段VBA代码可一键提取全部夹名至EXCEL中
功能:一键批量提取文件夹名至EXCEL中
运行环境:要求EXCEL支持VBA
运行效果如下:
以下为VBA代码
'************************************************************
Sub 提取本EXCEL同路径文件夹名称()
' '以下 清已提的文件夹名
Sheets("1名称目录处理").Select '清空工作表“1名称目录处理”中B3:B110区原内容,以清除上一次运行时产生的无用夹名
ActiveWindow.SmallScroll Down:=-12
Range("B3:B110").Select
Selection.ClearContents
'以下 自动提取文件夹名
Dim fs As Object
n = 3 '从第3行始,写入
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.getfolder(Sheets("1名称目录处理").Cells(1, 2)) '调取单元格B1中由公式自动生成的文件夹路径。(可在该单元格输入公式=LEFT(MID(CELL("filename",A1),1,SEARCH("[",CELL("filename",A1))-1),LEN(MID(CELL("filename",A1),1,SEARCH("[",CELL("filename",A1))-1))-1)'自动调用本EXCEL路径)
'也可直接输入绝对地址,(形如:“C:\Documents and Settings\Administrator\桌面\批提文件夹名”),读者可根据需要自行更改路径名称
For Each fd In f.subfolders
Cells(n, 2) = fd.Name 'Cells(n, 2)中n为行数,2为列数
n = n + 1
Next
Set f = Nothing
Set fs = Nothing
Range("B4").Select
ActiveWorkbook.Save
End Sub
'*****代码完**********************************************
联系客服