exeにすると動かない・・・

虎 2007-04-10 21:14:53 No: 136017

Private Sub Form_Load()
Dim loc_PATH            As String
Dim loc_RTN             As String
Dim Response            As String
Dim SH                  As Shell
Dim FI                  As FolderItem
Dim pub_PATH            As Variant
Dim pub_NAME            As Variant
Dim obj_FS              As Object
Dim loc_CHK             As Boolean
Dim intPlaceCount       As Integer
Dim intFileCount        As Integer
    cdl_TEST.DialogTitle = "ファイル選択"
    cdl_TEST.Filter = "全てのファイル(*.*)|*.*"
    cdl_TEST.InitDir = "C:\"
    cdl_TEST.Flags = cdlOFNHideReadOnly

    'ダイアログボックスを表示します
    cdl_TEST.ShowOpen
    Do
        If Len(cdl_TEST.FileName) <> 0 Then
            loc_PATH = cdl_TEST.FileName
            'ファイルが存在するかどうか確認します
            If CHK_FILE(cdl_TEST.FileName) = False Then
                MsgBox "ファイル名が間違っているか、ファイルが存在しません。" & Chr(13) & _
                       "再度ファイルを選択してから、[開く]ボタンを押してください。", vbExclamation, _
                       "ファイル選択エラー"
                cdl_TEST.FileName = ""
                GoTo NEXT_RTN
            Else
                GoTo SHELL_RTN
            End If
        End If
        '[キャンセル]ボタンを押した場合、終了します
        If cdlCancel Then      ' ＝ If Err.Number = 32755 Then
            Unload Me
            End
        End If
NEXT_RTN:
        '再度、ダイアログボックスを表示します
        cdl_TEST.ShowOpen
    Loop
SHELL_RTN:
    pub_NAME = prif_FILENAME(cdl_TEST.FileName)
    intPlaceCount = Len(cdl_TEST.FileName)
    intFileCount = Len(pub_NAME)
    Set SH = CreateObject("shell.application")
    Set FI = SH.NameSpace(Left(cdl_TEST.FileName, intPlaceCount - intFileCount - 1)).Items.Item(pub_NAME)
    FI.InvokeVerb
    End
    Exit Sub
END_RTN:
End Sub
'   ***********************************************
'       機能名      :   ファイルパスのチェック
'   ***********************************************
Private Function CHK_FILE(FILE_NAME As String) As Boolean
Dim obj_FS1 As FileSystemObject
Dim RTN_RES As Boolean
    Set obj_FS1 = CreateObject("Scripting.FileSystemObject")
    CHK_FILE = obj_FS1.FileExists(FILE_NAME)
    Set obj_FS1 = Nothing
End Function
'   ***********************************************
'       機能名      :   ファイルパスの取得
'   ***********************************************
Private Function prif_FILEPATH(FILE_NAME As String) As Variant
Dim obj_FS1      As Object
Dim obj_FILE1    As Object
    Set obj_FS1 = CreateObject("Scripting.FileSystemObject")
'   *****   ファイルのパスを取得
    Set obj_FILE1 = obj_FS1.GetFile(FILE_NAME)
    prif_FILEPATH = obj_FILE1.ParentFolder
    Set obj_FILE1 = Nothing
    Set obj_FS1 = Nothing
End Function
'   ***********************************************
'       機能名      :   ファイル名の取得
'   ***********************************************
Private Function prif_FILENAME(FILE_NAME As String) As Variant
Dim obj_FS2      As Object
Dim obj_FILE2    As Object
Dim FILE_CNT     As String
    Set obj_FS2 = CreateObject("Scripting.FileSystemObject")
    Set obj_FILE2 = obj_FS2.GetFile(FILE_NAME)

    'ファイルパスを取得します
    prif_FILENAME = obj_FILE2.ParentFolder

    'ファイルパスの文字数を返します
    FILE_CNT = Len(prif_FILENAME)
    FILE_CNT = FILE_CNT + 2

    'ファイル名を取得します
    prif_FILENAME = Mid(FILE_NAME, FILE_CNT)
    Set obj_FILE2 = Nothing
    Set obj_FS2 = Nothing
End Function

以上のようなプログラムを作成して実行したところ、目的通りファイルを開くウィンドウが表示されてファイルを選択すると目的のファイルを開くことが出来ます。
しかし上のファイルをexeに変換するとファイルを開くウィンドウは表示されるのですがファイルを指定してもファイルが開きません。

この件に限らずexeファイルにすると正常に動かなくなるのはどのような原因があるのでしょうか？そしてその解決方法を教えてください。

なお、exeファイルは作成したvbpファイルと同じ場所に保存しております。

さくら 2007-04-11 09:01:01 No: 136018

>解決方法を教えてください。

解決方法ではなくデバッグ方法です。

該当フォームのどこかに現在のプログラムの状態を表示するような場所
を作って、プログラムの進行に応じてそこを変化させるようなチェック
ルーチンを追加したらどうでしょうか？

IDEでデバッグ中ならDebug.Printのようなものが手軽に使えますが、
EXEにした場合は使えませんので代替機能を作ってしまえばいいわけです。

＃場合によってはC:\LOG.txtなどのファイルにイベントと時刻を書き
＃足していくなんてkともします。そのたびにCloseしないといけないかも。

魔界の仮面弁士 2007-04-11 09:25:56 No: 136019

> IDEでデバッグ中ならDebug.Printのようなものが手軽に使えますが、
> EXEにした場合は使えませんので代替機能を作ってしまえばいいわけです。

EXE のときは、App.LogEvent メソッドを使うのが手軽でよいかも。