SAK 図書館

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

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 ビジュアル編資料
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索



Copyright (C) 1999-2017 Y.SAK