| |
▼佐藤小次郎 さん：
前掲の File_Search() 修正版ですが、モジュール全体を読み返していて
おおよその利用法が分り、修正版の不具合が見つかりましたので、以下に
修正第2版を提示しておきます。
試されるときは こちらを使ってください。
'//New File_Search
Function File_Search() 'Dirコマンドによるファイル検索
Dim LookIn As String
Dim Filename As String
Dim SearchSubFolders As Boolean
Dim tmpPath As String
Dim sCmd As String
Dim ng As Long
Dim j As Long
Dim n As Long
Dim io As Integer
Dim buf() As Byte
Dim FoundFiles() As String
For j = Cnt(0) To 1 Step -1
LookIn = Left(TL_Path, Cnt(j)) '検索するフォルダ
SearchSubFolders = True 'Sub Folderも検索する
Filename = WK_Name '検索するファイル名
If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
'---- Dirコマンドによるサブフォルダを含むファイル名の検索
Filename = LookIn & Filename
tmpPath = Environ$("Temp") & "\Dir.tmp" '一時ファイルパス
sCmd = "DIR """ & LookIn & Filename & """ /b/s/a:-D > """ _
& tmpPath & """" '' /b ファイル名のみ
'' /s サブディレクトリも検索
'' /a:-D サブディレクトリー名は表示しない
'Dirコマンド実行(tmpファイルに出力)
With CreateObject("WScript.Shell")
ng = .Run("CMD /C " & sCmd, 7, True)
End With
If ng Then
MsgBox "ファイル検索時にエラーが発生しました." & vbCr _
& "処理を中断します", , LookIn & Filename
Open_SW = "Error"
Exit Function
End If
'----- Dirコマンドで取得したファイル名を配列に格納
If FileLen(tmpPath) < 2 Then
'このパスでは見つからなかったとき
Debug.Print LookIn, Filename, "→ NO FILES"
Open_SW = "Error" '次に検索パスに飛ぶ
Else
io = FreeFile()
Open tmpPath For Binary As io
ReDim buf(1 To LOF(io))
Get #io, , buf
Close io
Kill tmpPath
FoundFiles() = Split(StrConv(buf, vbUnicode), vbCrLf)
'同名ファイルが存在した場合、フォルダのパスをセット
For i = 0 To UBound(FoundFiles) - 1
If FoundFiles(i) Like "*" & Filename & "*" Then
WK_Path = FoundFiles(i)
Open_SW = "OK"
Exit For
End If
Next
End If
Next j
If Open_SW <> "OK" Then
MsgBox "【" & WK_Name & "】対象ファイルなし" & vbCr _
& "対象ファイルを準備後、処理して下さい。"
End If
End Function
前任者の方が コードにコメントをつけておいてくださったので、プログラム
の流れがつかめたのですが、それによりますと、
まず このマクロが書いてあるBookを立ち上げると、
２つのBook
"TEC103イベント一覧.xls"
"TEC104イベント対応.xls"
を開いて、UserForm上で更新処理をするようですね？
で、２つのBookが 最初に開くこのBook（ThisWorkbook） の保存されている
フォルダと同じフォルダにあればいいのですが、何らかの事情で、このBook
のあるフォルダのサブフォルダとか、このBookのあるフォルダと同列の別フォ
ルダとかに保存されていたばあい、それを探しに行くために
> Function File_Search()
があるようなのですね。
一つ目が "TEC103イベント一覧.xls" の存在チェックで、これがこのBook と
同じフォルダ内になかったばあい、
以下で、他のフォルダ（近所からだんだん上位フォルダに範囲を広げて）に
検索に行っています。
>' イベント一覧.xlsの存在チェックで、NGの場合、再度検索を行う。
>' └イベント一覧 検索
> If Open_SW1 = "NG" Then
> WK_Name = "TEC103イベント一覧.xls"
> WK_Path = ""
>
> File_Search 'イベント一覧.xlsの検索
>
> If Open_SW = "Error" Then Exit Sub
>
> AD_Name1 = WK_Name
> AD_Path1 = WK_Path '検索出来たイベント一覧.xlsの絶対パスをセット
> End If
２つめは イベント対応.xls のほうで、以下です。
> ' イベント対応.xlsの存在チェックで、NGの場合、再度検索を行う。
> ' └イベント対応 検索
> If Open_SW2 = "NG" Then
> WK_Name = "TEC104イベント対応.xls"
> WK_Path = ""
>
> File_Search 'イベント対応.xlsの検索
> If Open_SW = "Error" Then Exit Sub
> AD_Name2 = WK_Name
> AD_Path2 = WK_Path '検索出来たイベント対応.xlsの絶対パスをセット
> End If
そしてこれ以外に FileSearch を呼び出しているところはありません。
作られた方は 「自動で」必要なファイルを開く、ということにたいへんこだわって
いらっしゃるようで、そのようなコーディングが随所にみられます。
その代わり、
対象とするBookのファイル名は
> "TEC103イベント一覧.xls"
> "TEC104イベント対応.xls"
に固定ですから、事情があって、他のファイル名で同じ処理をしようとしても
それができません。
ぼくがつくるなら、Application.GetOpenFilename メソッドをつかって
イベント一覧用Bookと イベント対応用Book を ユーザーにダイアログ使って
選択させます。
そうすれば、名前が変更されていても、マクロブックと同じフォルダになくても
ユーザーが指定したファイルをもとに処理ができるようになります。
このなが〜いプログラムはほとんど数行に簡素化できるでしょう。
|
|
kanabun
- 14/8/14(木) 17:44 -
