SAK 図書館
SAK 図書館
VB テクニック編22 - ファイル検索、ディレクトリ検索、データグリッド(DataGrid)
■SAK 関数利用規程
・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
・著作権明示部分の改編は認めない。
・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
プログラムを開発することは自由です。
・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
その他有償プロダクトとして配布・販売するには、私の許可が必要です。
(無償のフリーソフトウェアなら、自由に配布しても良い。)
・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
賠償しません。
■ファイル検索(ファイル探索)
・ワイルドカード指定可能なファイル名検索は、次のようにする。
sch に検索するパス、ファイル名(ワイルドカード指定可) を指定し、
sb に true を指定すると、サブフォルダも再帰呼び出し検索する。
この例では、検索結果が fnm() と fnmmax に返る。
(fnm() は、配列受け渡し。配列引数、配列引渡し)
(再帰呼び出し処理、関数再帰処理)
dim fs as variant
dim fnm(999) as string
dim fnmmax as long
dim sch as string
dim sb as boolean
dim i as long
sch = "g:\tmp\*.txt"
sb = true
Set fs = CreateObject("Scripting.FileSystemObject")
fnmmax = -1
if SchFile(fs, sch , sb, fnm(), fnmmax, label1) then
cls
for i = 0 to fnmmax
print fnm(i)
next
if fnmmax = - 1 then msgbox "見つかりませんでした。"
else
msgbox "検索エラー"
end if
Public Function SchFile(fs As Variant, org As String, sb As boolean, fnm() as string, fnmmax as long, ctl as control) as boolean
Dim fld As Variant
Dim fc As Variant
Dim fl As Variant
Dim dnm As String
Dim wcd As String
Dim nm As String
Dim i As Long
SchFile = false
On Local Error Resume Next
i = InStrRev(org, "\")
If i > 0 Then
dnm = left(org, i)
wcd = right(org, len(org) - i)
if wcd = "" then wcd = "*.*"
Else
Exit Function
End If
DoEvents
nm = dir(org, 7)
do until nm = ""
ctl = "ファイル検索中... " & dnm & nm
ctl.Refresh
fnmmax = fnmmax + 1
fnm(fnmmax) = dnm & nm
if err <> 0 then
msgbox "ファイル名バッファオーバー"
exit function
end if
nm = dir
loop
If sb Then
Set fld = fs.GetFolder(dnm)
If Err <> 0 Then Exit Function
Set fc = fld.subFolders
For Each fl In fc
ctl = "ファイル検索中... " & dnm & fl.Name
ctl.Refresh
if SchFile(fs, dnm & fl.Name & "\" & wcd , sb, fnm(), fnmmax, ctl) = false then exit function
Next
End If
On Local Error GoTo 0
SchFile = true
End Function
■ディレクトリ検索(フォルダ検索)
・ディレクトリ名検索(フォルダ名検索) は、次のようにする。
sch に検索を開始するフォルダ、sky に検索フォルダ名を指定し、再帰呼び
出し検索する。この例では、検索結果が fnm() と fnmmax に返る。
(fnm() は、配列の受け渡し。配列引数)
sky に指定するフォルダ名は先頭一致で検索される。
dim fs as variant
dim fnm(999) as string
dim fnmmax as long
dim sch as string
dim sky as string
dim i as long
sch = "g:\tmp\"
sky = "sak"
Set fs = CreateObject("Scripting.FileSystemObject")
fnmmax = -1
if SchFld(fs, sch , sky, fnm(), fnmmax, label1) then
cls
for i = 0 to fnmmax
print fnm(i)
next
if fnmmax = - 1 then msgbox "見つかりませんでした。"
else
msgbox "検索エラー"
end if
Public Function SchFld(fs As Variant, org As String, sky As String, fnm() as string, fnmmax as long, ctl as control) as boolean
Dim fld As Variant
Dim fc As Variant
Dim fl As Variant
Dim dnm As String
Dim nm As String
Dim i As Long
SchFld = false
On Local Error Resume Next
i = InStrRev(org, "\")
If i > 0 Then
dnm = left(org, i)
Else
Exit Function
End If
DoEvents
Set fld = fs.GetFolder(dnm)
If Err <> 0 Then Exit Function
Set fc = fld.subFolders
For Each fl In fc
ctl = "フォルダ検索中... " & dnm & fl.Name
ctl.Refresh
if lcase(left(fl.Name, len(sky))) = lcase(sky) then
fnmmax = fnmmax + 1
fnm(fnmmax) = dnm & fl.Name
if err <> 0 then
msgbox "フォルダ名バッファオーバー"
exit function
end if
end if
if SchFld(fs, dnm & fl.Name & "\" , sky, fnm(), fnmmax, ctl) = false then exit function
Next
On Local Error GoTo 0
SchFld = true
End Function
■データグリッド(DataGrid)
・データグリッド(DataGrid) に Adodc から、データをセットするには、次の
ようにする。
実際には、Set DataGrid1.DataSource = Adodc1 はデザイン時に連結する。
あまりコードで連結はしない。
Dim dsn As String
Dim sql As String
dsn = "dsn=SAK3_ADO;uid=SAK;pwd=SAK"
sql = "select * from 受注m order by 受注番号"
Adodc1.ConnectionString = dsn
Adodc1.RecordSource = sql
DataGrid1.AllowAddNew = False
DataGrid1.AllowDelete = False
DataGrid1.AllowUpdate = False
Set DataGrid1.DataSource = Adodc1
・連結済みデータグリッド(DataGrid) の表示内容を変更するには、次のよう
にする。Adodc1.Refresh しないと、表示は変わらない。
Dim sql As String
sql = "select * from 受注m where 品番 like 'a%' order by 受注番号"
Adodc1.RecordSource = sql
Adodc1.Refresh
■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
Copyright (C) 1999-2018 Y.SAK