| |
▼佐藤小次郎 さん：
> Public WK_Name As String'ワーク用イベント一覧名（ファイル名）
> Public WK_Path As String ' ワーク用イベント一覧のフルパス名
> Public Cnt(60) ' カウンタの配列（イベント表検索にて使用）
> Public i, j, k ' 添字エリア
>
>Sub Auto_Open()
ぼくは Cnt(0) って何ですか？と聞いたのですから、〜用カウンタの配列
で Cnt(0) には 通常 5〜10くらいのカウンタが入っています... とか、
そういうことが知りたかったのですが。
元の Function File_Search() を
Function File_Search_Old()
とかに名前を変えてから、
以下の あたらしい Function File_Search() を挿入して、
試してみてください。
このコードは
ht tp://www.vbalab.sakura.ne.jp/vbaqa/c-board.cgi?cmd=one;no=74578;id=excel
を参考に、DirコマンドによりFileSearch代替処理を行っています。
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
Open_SW = "OK"
j = cnt(0)
Do Until j = 0
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 FileLen(tmpPath) < 2 Then ng = -10 'ファイルなし
If ng Then
MsgBox "【" & WK_Name & "】対象ファイルなし" & vbCr _
& "対象ファイルを準備後、処理して下さい。"
Open_SW = "Error"
Exit Function
End If
'----- Dirコマンドで取得したファイル名を配列に格納
Dim n As Long
Dim io As Integer
Dim buf() As Byte
Dim FoundFiles() As String
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)
n = UBound(FoundFiles) - 1
ReDim Preserve FoundFiles(n)
'同名ファイルが存在した場合、フォルダのパスをセット
For i = 0 To n
If "\" & Filename = Right$(FoundFiles(i), 17) Then
WK_Path = FoundFiles(i)
Exit Do
End If
Next
j = j - 1
Loop
End Function
Public 変数が多用されているので、
何がどう関係しているのか、サッパリ分りませんので、コードの字面だけ
Dirコマンドに置換しただけです。
うまく行くかどうかは たぶん 半々です。
それにしても
> Public i, j, k
はどうみてもおかしいですね？
|
|
kanabun
- 14/8/13(水) 9:40 -
