投稿日 | : 2007/04/18(Wed) 18:30 |
投稿者 | : ろん |
Eメール | : |
URL | : |
タイトル | : 選択したフォルダを表示させるアプリの不具合について |
皆様はじめまして、ろんと申します。
以下にVB6で作っているアプリの不具合につきまして
ご質問させていただきます。
OS:WinXP、VB6の環境で
フォームにラベル1つ、ボタン一つ用意して
ボタンが押されたら、フォルダ選択のダイアログを表示して
選択した時にそれをフォームのラベルに表示するアプリを作っています。
処理は、全てうまくいっていたのですが
フォルダを選択するダイアログを選択するファンクションを
抜けるとVB自体が落ちてしまう(強制終了されてしまう)という
状況になってしまいました。
なぜそのような状況になってしまったかというと
全て完成してセットアップをディストリビューションウィザードで作成して
テストでそのセットアップを実行して動かしてみたのですが、途中でアプリが落ちるという
状況で正常稼動しませんでした。
その為、そのセットアップされたものをアンインストールしました。
その時に何か重要なものが消されたのかも知れませんが
それ以降、VB開発環境上からも動かなくなってしまいました。
以下にモジュールを貼らせて頂きますので
識者の皆様、何が悪いのか何か足りないのか、ご助言頂けますでしょうか。
よろしくお願い致します。
【フォームのボタンクリックイベント】
Public Sub Command1_Click()
Form1.Label1 = GetFolderPathName("1")
End Sub
【フォルダ選択をするモジュール】
Option Explicit
Option Private Module
Type BROWSEINFO
hwnd As Long
pidlRoot As Long
pszDisplayName As String
myTitle As String
opFlags As Long
End Type
Public Const BIF_BROWSEFORCOMPUTER = 1
Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBROWSEINFO As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHFree Lib "shell32" Alias "#195" (ByVal pidl As Long) As Long
Public Function GetFolderPathName(Optional myprompt As String) As String
Dim typBROWSEINFO As BROWSEINFO
Dim LngPit As Long
Dim strPathName As String
Dim letter As String
Dim xx As Long
letter = "フォルダを指定します。"
With typBROWSEINFO
.myTitle = letter
.opFlags = BIF_BROWSEFORCOMPUTER
End With
LngPit = SHBrowseForFolder(typBROWSEINFO)
If LngPit = 0 Then Call SHFree(LngPit): GetFolderPathName = "": Exit Function
strPathName = String$(256, Chr(0))
SHGetPathFromIDList LngPit, strPathName
Call SHFree(LngPit)
For xx = 1 To 256
If Mid(strPathName, xx, 1) = Chr(0) Then
GetFolderPathName = Left(strPathName, xx - 1)
Exit For
End If
Next xx
End Function
以上、よろしくお願い致します。