0

このフォーラムからコードを見つけました。私は結果を達成するために一生懸命努力しましたが、この部分では失敗しました. f = fs.GetFile(fwb) を設定します。実行時エラー '53' 私は Win 7、Office 2013 で作業しています。

列 A にファイル名を含む Excel スプレッドシートがあります。列 A にリストされているファイル名は、1 つまたは複数のソース ディレクトリ内の 1 つまたは複数の Ms office .doc ファイルに表示されます。

.doc ファイルを再帰的に検索し、列 A で指定されたファイル名を含むファイルのパスを列 B に返すには、Excel が必要です。複数のファイルがある場合は、列 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
4

1 に答える 1

0 
fwb = Dir(fPath & "*.*")
...
Set f = fs.GetFile(fwb)  'Run time error '53'

Dir(...) 関数はファイル名 (例: "myfile.doc") のみを返すため、 GetFile(...) を呼び出すときはその前にディレクトリ パスを追加する必要があります。

Set f = fs.GetFile(fPath & fwb)
于 2013-09-17T06:52:28.300 に答える