VBA获取指定目录下的文件名(包括文件夹名)

zss7758258

用EXCEL VBA获取指定目录下的文件名(包括文件夹名)在网上看到的，觉得很好，所以拿来分享了
出处http://zhidao.baidu.com/link?url ... vT0n7oMLcbP-9s4gQm_

1. Sub GetFoldersAndFiles()
   
2.     Dim arr()
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         .InitialFileName = "C:"
   
5.         If .Show = True Then Path = .SelectedItems(1) & ""
   
6.     End With
   
7.     If Path = "" Then Exit Sub
   
8.     MyName = Dir(Path, vbDirectory)  '查找目录
   
9.         Do
   
10.             If MyName <> "." And MyName <> ".." Then
    
11.                 n = n + 1
    
12.                 ReDim Preserve arr(1 To n)
    
13.                 arr(n) = IIf((GetAttr(Path & MyName) And vbDirectory) = vbDirectory, "<" & MyName & ">", MyName)
    
14.             End If
    
15.             MyName = Dir
    
16.         Loop While MyName <> ""
    
17.     Sheet1.Range("A1").Resize(n, 1) = WorksheetFunction.Transpose(arr)
    
18.     Sheet1.Range("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    
19.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    
20.         :=xlPinYin, DataOption1:=xlSortNormal
    
21.    
    
22. End Sub

复制代码

zss7758258

参考http://club.excelhome.net/forum. ... 563&pid=7045180

在Thisworkbook下粘贴如下代码

1. Sub g1()
   
2. 
   
3.     Dim fso, fl, m&
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     For Each fl In fso.getfolder(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path & "").Files
   
6.        m = m + 1
   
7.        Cells(m, 1) = fl.Name
   
8.     Next
   
9. 
   
10. End Sub
    

复制代码