＜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
で比較した時、実行時エラーで落ちたのですが、
なぜでしょうか？

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

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

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

VBA系の無料メルマガ書いてます
メルマガ『ＶＢＡで楽しくプログラミング』(無料) を購読しませんか？
	E-mail

ＶＢＡで楽しくプログラミング	最新情報	掲示板	バックナンバー	メルマガ登録と解除
コンビニのオモテとウラ話	最新情報	掲示板	バックナンバー	メルマガ登録と解除
ＡＳＰで遊ぶ、失敗する	最新情報	掲示板	バックナンバー	メルマガ登録と解除
AB型三流ＰＧ 業務のグチ	最新情報	掲示板	バックナンバー	メルマガ登録と解除
初心者にやさしいプログラム	最新情報	掲示板	バックナンバー	メルマガ登録と解除
ネットで稼ぐ本音と失敗談	最新情報	掲示板	バックナンバー
www.ken3.org(サイト内)から を利用して、 を