[[20201004204919]] 『APIを64bitに対応したいがうまく動作しない。』(えのりん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『APIを64bitに対応したいがうまく動作しない。』(えのりん)

パスを取得するためのコードがあるのですが、昔、このサイトで教えていただいた借り物のコードで、よく意味も分からず使っています。

これを PtrSafe ,  #If VBA7 Then で 対応したいと思っているのですが「コンパイルエラー・型が違います」となってしまいます。

おそらく longPtr の使い方が間違っているのでは、と思うのですが、実際、APIはおろか、引数の型とか、Typeメンバの型とか、まるで分っていないVBA素人です。厚かましい次第ですが、どうかご指導ください。

以下コードです

エラーメッセージが出たとき

 pidl = SHBrowseForFolder(bif)
の部分が色が反転します。

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

#If VBA7 Then
Declare PtrSafe Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As LongPtr
Declare PtrSafe Function SHGetPathFromIDList Lib "shell32" (ByVal pidl As Long, ByVal pszPath As String) As LongPtr
Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As LongPtr
#Else
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#End If

Public Const CSIDL_DESKTOP = &H0 'デスクトップ
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_RETURNONLYFSDIRS = &H1 'フォルダのみ選択可能

Public Function GetFolder(strComent As String, strPath As String) As Boolean

    Dim bif As BROWSEINFO
    Dim pidl As Long

    On Error GoTo ErrGetFolder

    With bif
        .hWndOwner = Hwnd
        .pidlRoot = CSIDL_DESKTOP
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpszTitle = strComent
    End With

    pidl = SHBrowseForFolder(bif)

    If pidl <> 0 Then
        strPath = String$(256, vbNullChar)
        SHGetPathFromIDList pidl, strPath
        strPath = Left(strPath, InStr(strPath, vbNullChar) - 1)
        GetFolder = True
    Else
        GetFolder = False
    End If

    Exit Function

ErrGetFolder:

    GetFolder = False

< 使用 Excel:Excel2016、使用 OS:Windows10 >


こちらが参考になるのでは?

「VBA Excel2013(64bit)フォルダ参照のダイアログ」
https://social.msdn.microsoft.com/Forums/ja-JP/eaf2b8bc-d84f-4b98-9890-fdad67c852c3/vba?forum=vbajp

(私は内容について熟知しているわけではなく、環境もないので、追加質問にはお答えできません。

  予めお知らせします。)
(γ) 2020/10/04(日) 22:18

どストライクなリンクを貼っていただきありがとうございました。コピペで解決しました。
(えのりん) 2020/10/05(月) 10:34

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.