VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [管理用]

投稿日: 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

以上、よろしくお願い致します。


- 関連一覧ツリー (★ をクリックするとツリー全体を一括表示します)

- 返信フォーム (この記事に返信する場合は下記フォームから投稿して下さい)

- VBレスキュー(花ちゃん) - - Web Forum -