[ツリー表示へ] [ワード検索] [Home]
タイトル ： Re^13: ポータブルデバイスのフォルダパス取得 投稿日 ： 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 よろしくおねがいいたします。 |
をクリックするとツリー全体を一括表示します） - ポータブルデバイスのフォルダパス取得 - NANA 14/11/07-21:48No.15986