<em id="pj4oa"><acronym id="pj4oa"></acronym></em><button id="pj4oa"><object id="pj4oa"></object></button>
<progress id="pj4oa"><track id="pj4oa"><rt id="pj4oa"></rt></track></progress>

    <dd id="pj4oa"></dd>
    <th id="pj4oa"></th>

    返回首頁
    當前位置: 主頁 > Excel教程 > Excel VBA教程 >

    excel利用VBA獲取文件夾中的文件列表

    時間:2012-07-19 22:03來源:Office教程學習網 www.tin22.com編輯:麥田守望者

    如果我們要在Excel中獲取某個文件夾中所有的文件列表,可以通過下面的VBA代碼來進行。代碼運行后,首先彈出一個瀏覽文件夾對話框,然后新建一個工作簿,并在工作表的A至F列分別列出選定文件夾中的所有文件的文件名、文件大小、創建時間、修改時間、訪問時間及完整路徑。方法如下:

    1.按Alt+F11,打開VBA編輯器,單擊菜單“插入→模塊”,將下面的代碼粘貼到右側的代碼窗口中:

    Sub GetFileList()
    Dim strFolder As String
    Dim varFileList As Variant
    Dim FSO As Object, myFile As Object
    Dim myResults As Variant
    Dim l As Long
    '顯示打開文件夾對話框
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub '未選擇文件夾
    strFolder = .SelectedItems(1)
    End With
    '獲取文件夾中的所有文件列表
    varFileList = fcnGetFileList(strFolder)
    If Not IsArray(varFileList) Then
    MsgBox "未找到文件", vbInformation
    Exit Sub
    End If
    '獲取文件的詳細信息,并放到數組中
    ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)
    myResults(0, 0) = "文件名"
    myResults(0, 1) = "大小(字節)"
    myResults(0, 2) = "創建時間"
    myResults(0, 3) = "修改時間"
    myResults(0, 4) = "訪問時間"
    myResults(0, 5) = "完整路徑"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For l = 0 To UBound(varFileList)
    Set myFile = FSO.GetFile(strFolder & "\" & CStr(varFileList(l)))
    myResults(l + 1, 0) = CStr(varFileList(l))
    myResults(l + 1, 1) = myFile.Size
    myResults(l + 1, 2) = myFile.DateCreated
    myResults(l + 1, 3) = myFile.DateLastModified
    myResults(l + 1, 4) = myFile.DateLastAccessed
    myResults(l + 1, 5) = myFile.Path
    Next l
    fcnDumpToWorksheet myResults
    Set myFile = Nothing
    Set FSO = Nothing
    End Sub

    Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant
    ' 將文件列表放到數組
    Dim f As String
    Dim i As Integer
    Dim FileList() As String
    If strFilter = "" Then strFilter = "*.*"
    Select Case Right(strPath, 1)
    Case "\", "/"
    strPath = Left(strPath, Len(strPath) - 1)
    End Select
    ReDim Preserve FileList(0)
    f = Dir(strPath & "\" & strFilter)
    Do While Len(f) > 0
    ReDim Preserve FileList(i) As String
    FileList(i) = f
    i = i + 1
    f = Dir()
    Loop
    If FileList(0) <> Empty Then
    fcnGetFileList = FileList
    Else
    fcnGetFileList = False
    End If
    End Function
    Private Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)
    Dim iSheetsInNew As Integer
    Dim sh As Worksheet, wb As Workbook
    Dim myColumnHeaders() As String
    Dim l As Long, NoOfRows As Long
    If mySh Is Nothing Then
    '新建一個工作簿
    iSheetsInNew = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set wb = Application.Workbooks.Add
    Application.SheetsInNewWorkbook = iSheetsInNew
    Set sh = wb.Sheets(1)
    Else
    Set mySh = sh
    End If
    With sh
    Range(.Cells(1, 1), .Cells(UBound(varData, 1) + 1, UBound(varData, 2) + 1)) = varData
    .UsedRange.Columns.AutoFit
    End With
    Set sh = Nothing
    Set wb = Nothing
    End Sub

    2.關閉VBA編輯器,回到Excel工作表中,按Alt+F8,打開“宏”對話框,選擇“GetFileList”,單擊“運行”按鈕。

    ------分隔線----------------------------
    標簽(Tag):excel excel2007 excel2010 excel2003 excel技巧 excel教程 excel實例教程 excel2010技巧
    ------分隔線----------------------------
    推薦內容
    猜你感興趣
    五月婷婷福利