＜VB5 Setup.exe を探し一覧表示する＞

下記のような依頼メールを出向先の同僚からいただきました。
---------------
現在CD-ROMに焼いて各支店に配っているAccessで作ったシステムが
あるのですが、毎月セットアップをしなくてはならないため、CD-ROM
挿入後自動でセットアッププログラムを起動させたいのですが、

以下のようなディレクトリ構成でそれぞれにセットアッププログラム
があり、それらを選択するプログラムを必要です。

■Pattern A
　CD-ROM
　　+SLS
　　　　+事業部名
　　　　　　+Tokyo
　　　　　　+Osaka
　　　　　　+Nagoya
　　　　　　　 ：　
■Pattern B
　CD-ROM
　　+SLS24
　　　　+事業部名
　　　　　　+Tokyo
　　　　　　+Osaka
　　　　　　+Nagoya
　　　　　　　 ：　
　※事業部名はそれぞれのCD-ROMによって異なる。

サブディレクトリを読み取って、ユーザーにセットアップを選択させる
プログラムの開発をお願いします。
本来であれば、私が作成すればいいのでしょうが、こちらにVBやVCと
いった環境がないものですから.....
---------------

各ディレクトリに入っている
Ｓｅｔｕｐ．ｅｘｅの起動プログラムねぇ、、、
エクスプローラで起動する丁寧なマニュアルを配布先に渡したほうが
いいような気がするけど、、、（また、始まったよ、やりたくない病？）

起動ドライブのＳｅｔｕｐ.ｅｘｅファイルを探す

起動する

エラーだけどＳｅｔｕｐ．ｅｘｅが起動したのでほっとする


'-----
'ＶＢ５でフォームを１つ作りモジュール、、、に書いてみた、、
'リストボックスにＳｅｔｕｐ．ｅｘｅの場所を表示して、
'選択後起動するサンプルです。
Private strDRV As String
Private strDirList(10000) As String
Private nDirCnt As Integer

Private Sub cmdEND_Click()
    Unload Me
    End
End Sub

Private Sub cmdRunSetup_Click()
    '念のため、実行確認
    If vbNo = MsgBox(Me.SetupList & "を実行します", vbYesNo) Then
        Exit Sub
    End If
    
    'Shell関数で起動
    Shell Me.SetupList, vbNormalFocus
    
    '自分自身を終了させる
    Unload Me
    End
    
End Sub

Private Sub Form_Activate()

    Dim n        As Integer
    Dim strFNAME As String

    If nDirCnt = 1 Then
        'ディレクトリの一覧を取得する（手抜き）
        Call searchDir(strDRV)
        'Setup.exe があるか、あらためて探す
        '(同時に探したほうが速いのにねぇ、、、)
        For n = 1 To nDirCnt
            strFNAME = strDirList(n) & "setup.exe"
            Me.Caption = strFNAME & "検索中"
            DoEvents
            If Dir(strFNAME) <> "" Then
                Me.SetupList.AddItem strFNAME
            End If
        Next n
        Me.Caption = "検索終了、、、"
    End If

End Sub

Private Sub Form_Load()
    
    '検索ドライブを自分のパスから判断
    strDRV = Left(App.Path, 1) & ":\"
    Me.labTitle.Caption = strDRV & "ドライブのSetup.exe 一覧"
    
    'カウンタの初期化
    nDirCnt = 1

End Sub

Private Sub searchDir(strSearchPath As String)

    Dim strWORK As String
    Dim strCHK  As String
    
    Dim nSTART  As Integer
    Dim nEND    As Integer
    
    Dim n       As Integer
    
    nSTART = nDirCnt   '格納開始位置を保存する
    
    'まず、受け取ったディレクトリから下のディレクトリを
    '変数に格納する
    
    If Right(strSearchPath, 1) <> "\" Then
        strSearchPath = strSearchPath & "\"
    End If
    
    strWORK = Dir(strSearchPath, vbDirectory)    ' 最初のフォルダ名を返します。
    Do While strWORK <> ""   ' ループを開始します。
        ' 現在のフォルダと親フォルダは無視します。
        If strWORK <> "." And strWORK <> ".." And strWORK <> "pagefile.sys" Then
            'チェックするファイル名を作成
            strCHK = strSearchPath & strWORK
            ' ビット単位の比較を行い、フォルダかどうかを調べます。
            If (GetAttr(strCHK) And vbDirectory) = vbDirectory Then
                ' フォルダであれば、それを変数にセットします。
                'ReDim strDirList(nDirCnt + 1) As String '配列の要素の数を増やします
                strDirList(nDirCnt) = strCHK
                Me.Caption = strCHK & "検索中"
                DoEvents
                nDirCnt = nDirCnt + 1
            End If
        End If
        strWORK = Dir                    ' 次のフォルダ名を返します。
        DoEvents
    Loop
    
    nEND = nDirCnt  '終了位置を保存する
    
    If nSTART = nEND Then  '1つも見つからなかった？
        '何もしない
    Else
        '今回新規にサーチしたディレクトリ数分その下を調べる
        For n = nSTART To nEND - 1
            Call searchDir(strDirList(n))
        Next n
    End If

End Sub
'-----
なってないなぁ、、、
芸術的な流れはこれだぞって指摘、待ってます。
ささいなことでも、気がついたことあったら送ってください。

/*
 * ４．またまた増える今後の課題？
*/
簡単な解説とダメ処理のまとめを書きます。

Form_Load()のイベントで、起動したドライブを取り出します。
'検索ドライブを自分のパスから判断
strDRV = Left(App.Path, 1) & ":\"
ポイントはApp.PathでＶＢで作成したＥｘｅの場所がわかると思う。
＊自分へ文句  \\SRV1\CD\XXXX.EXE で、サーバーのＣＤから起動したら、
　どうなんだよ、、、

次に、Form_Activate()のイベントで、
ディレクトリをサーチし、Ｓｅｔｕｐ.ｅｘｅを探し、
リストボックスへセットします。
Me.SetupList.AddItem strFNAME
..AddItemヘルプでみて下さい。

ディレクトリのサーチは、ｄｉｒ関数を使用し、
strWORK = Dir(strSearchPath, vbDirectory) 
で回しました。

あとは、目新しい処理しないで普通にやっていると思います。。

三流なんだねその１
　なんで固定の10000なの？
　Private strDirList(10000) As String
　一万件越えたらどうするつもりなんだよ、、メモリもムダにするし。
  'ReDim strDirList(nDirCnt + 1) As String '配列の要素の数を増やします
　はじめは、上記のように、
　ReDim を使用して、増やしながらやろうと書きましたが、
　再帰処理で再度関数を呼ぶとエラーになったので、
　手抜きでstrDirList(10000) As Stringにしました。
　（おいおい、頼むよ、、しっかりしてよ、、、）

三流なんだねその２
一流読者さんへ素朴な質問、
"c:\pagefile.sys"を
If (GetAttr(strCHK) And vbDirectory) = vbDirectory Then
で比較した時、実行時エラーで落ちたのですが、
なぜでしょうか？

/*
 * ５.終わりの挨拶
*/

今回のグチりながらのボロボロなプログラム作成、、どうでしたか？
なめてないで、流れをはじめに考えてから作らないと、
こんな汚いプログラム（動けばいいや的処理）になってしまいます。

えっ、三流のＫｅｎ３らしい、、、
なんて声聞こえたところで、今日も逃げるように。。。

質問や要望、クレームを送る(三流君に連絡する 連絡方法)

質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)

感想や質問・要望・苦情など 三流君へメッセージを送る。 時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。 あなたのお名前（ニックネーム）:さん 返信は？: 不用(HP更新を待つ) , E-mail→ アドレス:に返事をもらいたい ここに 感想や質問・要望・苦情など 三流君へ送るメッセージを 気軽に書いてください (感想や質問・要望・苦情はHPで記事に載せることがあります。)

急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。

番外編 愚痴系で書いてた今日の一品 (短いサブ関数など)