0

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

テキスト ファイルを再帰的に検索し、列 A で指定されたファイル名を含むファイルのパスを列 B に返すには、Excel が必要です。複数のファイルが列 C に移動する場合など。

Excelシートは

__________________________________
__|______A___________|______B_____|
1 | filename.avi     |            |
2 | another_file.flv |            |

検索するテキスト ファイルは C:\WebDocs\ の下の複数のディレクトリにあり、返される必要があるこのページのように非常に短い DokuWiki ページです。

===== Problem Description =====
Reopen a closed bank reconciliation.

===== Solution =====
Demonstration of the tool box routine that allows reposting of the bank rec.

{{videos:bank_rec_reopen1006031511.flv|}}

===== Additional Information -cm =====
You may have noticed that in the video there is a number to the right of the bank account number. In this case it was a 0. That indicates department 0 which is all departments. You get the department 0 if you have all departments combined using the option in the bank set up called "One Bank for All Departments". If this setting is not checked then when you create your starting bank rec for each department you will get a 1 to the right of the bank rec for department 1 and so on. You should normally only have a 0, or have numbers 1 or greater. If you have both, then the method was changed after the initial bank rec was made. You just have to be aware of this as you move forward. As always backup before you make any changes.

ビデオを含まないが、検索対象のディレクトリに含まれる非常に長いページが他にもいくつかあります。形式は同じで、プレーン テキストです。==== は見出しのプレース ホルダーであり、他のページ/サイトへのリンクを含めることができます。

必要なことを実行する既存の VBA スクリプトを見つけました。再帰せず、パスだけが必要な場合、たとえば日付/時刻スタンプなど、あまりにも多くの情報を返します。

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)
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

2 に答える 2

0

私の限られた経験から、4 つのタスクを実行する必要があるようです。

1)ディレクトリをループする

2）ディレクトリごとにファイルをループします（ファイル名を変数に保持することをお勧めします）

3) テキスト ファイルの値をテストします。「落書きシート」をクリアし、ファイルをインポートして、チェックを実行することをお勧めします。例えば

    Sheets("YourScratchPatch").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & yourpath & yourfile.txt, Destination:=Range("A1"))
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 2
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

4) 値が見つかった場合は、ファイル名変数をインデックス シートに書き込みます。

比較チェックを行うためのより良い（配列？）方法があるはずですが、それはテキストファイルの内容に依存します（つまり、ファイル名が1つだけですか？）

テキストファイル構造に関する詳細情報が役立ちます。お役に立てれば。

于 2013-06-18T09:55:21.770 に答える