| |
こんにちは よろしくお願い致します
APIを使用したファイルの高速検索処理
▼【58198】再帰処理でのファイル検索
tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=58198;id=excel
でお世話になりました
最後のほうに記載のある
kanabunさんの 【58200】Re:再帰処理でのファイル検索 のコードで
Sub Try_Start()
If n Then
MsgBox Join(myList, vbCr), , strFind & " ---> " & n & " Files"
Else
MsgBox "該当ファイルなし"
End If
の
MsgBox Join(myList, vbCr)
を
Cells(1, 1) = Join(myList, vbCr)
で、シートに一発展開できるので、対象ファイルが600程度あっても
4秒程度で処理が完了なのですが
上記に加えて
1）フォルダの階層が深いのでフルパスではなく指定フォルダ以下のパスに修正
2）特定ブックの時だけ、指定セルから値取得したいと思っています
で、
Cells(1, 1) = Join(myList, vbCr)
の変わりに
For CNTR = 1 To UBound(myList)
'ブックの入力シートのAX69のセルが空値で無ければ、その値を取得
If IsError(TG_Val_M4(myList(CNTR), "ST1", "AX", 69)) = True Then
Else
Cells(ROW_CNT, 1) = Left(RE_PATH(myList(CNTR), "\", 8), 7) & "___ " & TG_Val_M4(myList(CNTR), "入力S", "AX", 69)
ROW_CNT = ROW_CNT + 1
End If
'ブックのあるフォルダ以下のパス記載
Cells(ROW_CNT, 1) = RE_PATH(myList(CNTR), "\", 8)
ROW_CNT = ROW_CNT + 1
Next
なんてすると、一機十倍以上の時間が掛かってしまいます
どのような処理にすればよいでしょうか
補足
'シートの AX69 の値取得
Public Function TG_Val_M4(tg_f_path As String, tg_s As String, cn As String, rc As Integer)
TG_Val_M4 = Application.ExecuteExcel4Macro("'" & Left(tg_f_path, InStrRev(tg_f_path, "\")) & _
"[" & Right(tg_f_path, Len(tg_f_path) - InStrRev(tg_f_path, "\")) & "]" & _
tg_s & "'!R" & rc & "C" & Columns("" & cn & "").Column)
End Function
'↑下記を後から作成したので・・そのままです・・・
'フルパスを特定のパス以下に変更する
Function RE_PATH(strWords As String, strDelim As String, ori_cnt As Integer)
Dim astrWords() As String
Dim cnt As Long
Dim NEW_WD As String
astrWords = Split(strWords, strDelim)
For cnt = ori_cnt To UBound(astrWords)
NEW_WD = NEW_WD & "\" & astrWords(cnt)
Next
'RE_PATH2 = NEW_WD
'最初の\を取り除く
RE_PATH = Mid(NEW_WD, 2, Len(NEW_WD))
End Function
追記
1）フォルダの階層が深いのでフルパスではなく指定フォルダ以下のパスに修正
は、エクセルでの置換機能でもいいと思っていますが
2）特定ブックの時だけ、指定セルから値取得したいと思っています
の処理が必要です
また、
多分、ブックを開かないので Application.ExecuteExcel4Macro が
最速ではないかと思っているのですが、この辺もアドバイスありましたら
よろしくお願い致します
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
