| |
パソコンを入れ替えたため、Excel2003→2010になって苦労してます。
フォルダにテキストファイルがあり、それを読み込んで、先頭データが検索条件に一致したものだけをシートにリストアップします。
今まではFileSearchを使用していましたが、2010では使えないので、
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet, i As Long, j As Long, zuban As Variant, myname As Variant
Dim flag As Boolean, k As Long, flag0 As Boolean, path As Variant, fn As Variant
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ws1 = Worksheets(1)
ws1.Range("A:C").ClearContents
If ws1.Range("F2") = "" Or ws1.Range("E2") = "" Then Exit Sub
ws1.Range("F3") = "検索中です。しばらくお待ち下さい。"
k = 1
path = "Y:\DB\流用図\F" & ws1.Range("E2")
For Each File In FSO.GetFolder(path).Files
flag = False: flag0 = False
Open path & "\" & File.Name For Input As #1
Line Input #1, zuban
If EOF(1) = False Then
Line Input #1, myname
Else
flag0 = True
End If
Close #1
If flag0 = False Then
If Len(myname) >= Len(ws1.Range("F2")) Then
If myname = ws1.Range("F2") Then
flag = True
ElseIf Len(myname) > Len(ws1.Range("F2")) Then
j = 1
Do
If Mid(myname, j, Len(ws1.Range("F2"))) = ws1.Range("F2") Then
flag = True
Else
j = j + 1
End If
Loop Until flag = True Or Len(ws1.Range("F2")) + j - 1 > Len(myname)
End If
If flag = True Then
ws1.Range("A" & k) = zuban
ws1.Range("B" & k) = myname
ws1.Range("C" & k) = Left(File.Name, Len(File.Name) - 4)
ws1.Cells(k, 1).Select
k = k + 1
End If
End If
End If
Next File
ws1.Range("F3") = "３列目をダブルクリックすると、図面が見れます。"
End Sub
素人が作ったものなので醜くてすいません。
上記で動かすと、フォルダ内のファイルが少ないとうまく行くのですが、多いといつまで待っても動きません。
2003-FileSearchでやっていたときは、古い、とろくさいパソコンでも3分ほどで処理できてたのですが・・・。
なにかアドバイスがあれば、よろしくお願いいたします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
