簡體   English   中英

搜索文件以獲取excel單元格中包含的信息並返回路徑

[英]Search files for information contained in excel cell and return path

我從該論壇找到了代碼。 我已經非常努力地實現了結果,但是在這一部分上卻失敗了。 設置f = fs.GetFile(fwb)。 運行時錯誤'53'我正在使用Win 7,Office 2013。

我有一個Excel電子表格,其中A列中有一個文件名。A列中列出的文件名出現在一個或多個源目錄中的一個或多個Ms office .doc文件中。

我需要Excel遞歸搜索.doc文件,並將包含A列中指定的文件名的文件的路徑返回到B列。如果有多個文件,請轉到C列,依此類推。

我非常需要這個宏。 請有人幫我。

__________________________________
         __|______A_____|______B_____|_____
         1 | test_1.doc |c:\cost\test_1.doc|
         2 | test_2.doc |c:\cost\test_2.doc|
    Private Sub CommandButton1_Click()
        Dim sh As Worksheet, rng As Range, lr As Long, fPath As String
        Set sh = Sheets(1) 'Change to actual
        lstRw = sh.Cells.Find(
            What:="*", 
            After:=sh.Range("A1"),
            LookAt:=xlPart, 
            LookIn:=xlFormulas, 
            SearchOrder:=xlByRows, 
            SearchDirection:=xlPrevious, 
            MatchCase:=False
        ).Row
        Set rng = sh.Range("A2:A" & lstRw)
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            fPath = .SelectedItems(1)
        End With
        If Right(fPath, 1) <> "\" Then
            fPath = fPath & "\"
        End If
        fwb = Dir(fPath & "*.*")
        x = 2
        Do While fwb <> ""
            For Each c In rng
                If InStr(LCase(fwb), LCase(c.Value)) > 0 Then
                    Worksheets("Sheet2").Range("C" & x) = fwb
                    Set fs = CreateObject("Scripting.FileSystemObject")

                    Set f = fs.GetFile(fwb)  'Run time error '53'

                    Worksheets("Sheet2").Range("D" & x) = f.DateLastModified
                    Worksheets("Sheet2").Range("B" & x) = f.Path
                    Worksheets("sheet2").Range("A" & x) = c.Value
                    Columns("A:D").AutoFit
                    Set fs = Nothing
                    Set f = Nothing
                    x = x + 1
                End If
            Next
            fwb = Dir
        Loop
        Set sh = Nothing
        Set rng = Nothing
        Sheets(2).Activate
    End Sub
fwb = Dir(fPath & "*.*")
...
Set f = fs.GetFile(fwb)  'Run time error '53'

Dir(...)函數僅返回文件名(例如“ myfile.doc”),因此在調用GetFile(...)時必須在其前面添加目錄路徑:

Set f = fs.GetFile(fPath & fwb)

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM