| タイトル | ： Re^13: ポータブルデバイスのフォルダパス取得 |
| 記事No | ： 16001 |
| 投稿日 | ： 2014/11/11(Tue) 11:52 |
| 投稿者 | ： NANA |
魔界の仮面弁士 様
ご連絡ありがとうございます。
MTPデバイス内のPIDよりパスを取得することは
出来ませんでした。（値は無し）
よろしくおねがいいたします。
'標準モジュール
************************************************
'フォルダ名最大
Private Const MAX_PATH As Long = 256
'フォルダ選択ダイアログを表示
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
'上記関数で取得したポインタを元にフォルダを取得
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidl As Long, ByVal pszPath As String) As Long
'SH〜で取得したメモリブロックを開放する
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pidl As Long)
'デスクトップハンドルを取得する
Private Declare Function GetDesktopWindow Lib "USER32" () As Long
'Root定数
'デスクトップ
Private Const CSIDL_DESKTOP As Long = &H0&
'Flags定数
'フォルダのみ選択可能
Private Const BIF_RETURNONLYFSDIRS As Long = &H1&
'ブラウザ情報構造体
Private Type BROWSEINFO
hWndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As String
iImage As Long
End Type
' フォルダー選択ダイアログを表示する。
' strCaption ダイアログのキャプション
' lngOwnerHwnd ダイアログのオーナーウィンドウ。
' lngRoot ルートフォルダ CSIDL*** 定数を使用する。
' lngFlags
' BIF_xxx の定数の組み合わせを指定。
' 省略時はフォルダーのみを選択。
' strParam
' デフォルトのフォルダー名。
' 省略時はマイコンピューターやルートに指定したフォルダ。
Public Function selectFolder( _
Optional ByRef strCaption As String = vbNullString, _
Optional ByVal lngOwnerHwnd As Long = 0, _
Optional ByVal lngRoot As Long = CSIDL_DESKTOP, _
Optional ByVal lngFlags As Long = BIF_RETURNONLYFSDIRS, _
Optional ByRef strParam As String = vbNullString) As String
On Error GoTo ErrorHandler
Dim typBinfo As BROWSEINFO 'フォルダ情報構造体
Dim lngpid As Long
Dim strPath As String
'親Windowが指定されていなければデスクトップを親Windowにする
If lngOwnerHwnd = 0 Then
lngOwnerHwnd = GetDesktopWindow()
End If
'バッファ設定
strPath = String$(MAX_PATH, vbNullChar)
'BROWSEINFO 構造体設定
With typBinfo
.hWndOwner = lngOwnerHwnd
.pidlRoot = lngRoot
.pszDisplayName = strPath
.lpszTitle = strCaption & vbNullChar
.ulFlags = 0 'この箇所を0にしないとMTPデバイスが選択できない
'デフォルトフォルダが指定されていたらコールバック関数を使用する
If Len(strParam) > 0 Then
.lpfn = GetAddressOF(AddressOf BForFolderCallbackProc)
.lParam = strParam & vbNullChar
End If
End With
' フォルダー選択ダイアログを表示
lngpid = SHBrowseForFolder(typBinfo)
'コンピュータ名のみ選択する場合
If typBinfo.ulFlags And BIF_BROWSEFORCOMPUTER Then
strPath = typBinfo.pszDisplayName
'不要文字列を削除する
strPath = Left$(strPath, InStr(strPath, vbNullChar) - 1)
'フォルダ名やコンピュータ名取得
Else
'キャンセルが押された場合
If lngpid = 0 Then
strPath = vbNullString
'OKが押された場合
Else
'pidよりパスを取得する
If SHGetPathFromIDList(lngpid, strPath) = 0 Then
strPath = vbNullString
Else
' Null切捨て
strPath = Left$(strPath, InStr(strPath, vbNullChar) - 1&)
End If
End If
End If
'ITEMIDLIST解放
Call CoTaskMemFree(lngpid)
'戻値
selectFolder = strPath
Exit Function
ErrorHandler:
Call MsgBox(Err.Description, vbCritical)
End Function
' 長文になるためコールバック関数は省かせていただきます。
************************************************
Private Sub Command1_Click()
MsgBox selectFolder("aaaaa", 0, CSIDL_DESKTOP, 1, "")
End Sub
よろしくおねがいいたします。
|