「指定したフォルダにあるファイルを書き出す」古いマクロの修正

20年くらいまえにネットで拾った「指定したフォルダにあるファイルを書き出す」マクロを愛用していたのですが、Office365にして以降（？）か、以下のエラーが出て実行できなくなりました。


//ここから
コンパイル エラー: このプロジェクトのコードは、64 ビット システムで使用するために更新する必要があります。Declare ステートメントの確認および更新を行い、次に Declare ステートメントに PtrSafe 属性を設定してください。
//ここまで

・・・具体的には上記エラー＋以下の8行目の「Declare Function 」全体が赤字にハイライトされて止まります。

ファイル名一覧という動作をするプログラム自体は世の中に数多ありますが、シンプルな動作で気に入っており、修正が可能なら方法をご教示いただけますと幸いです。XLSのプロパティをみたら、1998年に某大学の研究室で作られたもののようですが、

なお、投稿文字数制限の関係で、全体は画像で示します。



Type SHFileInfo ' ユーザー定義型を作成します。
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * 260
szTypeName As String * 80
End Type
Declare Function SHGetFileInfo Lib "shell32.dll" _
Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttribute As Long, _
psfi As SHFileInfo, _
ByVal cbFileInfo As Long, _
ByVal uFlags As Long) As Integer
Public Const SHGFI_TYPENAME = 1024
Public Const SHGFI_DISPLAYNAME = 512
' ファイルの情報を返す
' s:ファイル名
' index: 情報の種類
' 0: ファイルの種類
' 1: エクスプローラで表示されるファイル名
Function SHInfo(s As String, index As Integer) As String
Dim info As SHFileInfo
Dim r As Integer

：
：以降投稿文字数制限の関係で省略、画像ご参照

No.1 ベストアンサー 回答者： fujillin 回答日時： 2021/05/30 17:32

こんにちは

エラー文章の示す通りです。

＞Declare Function SHGetFileInfo Lib "shell32.dll" ～～
の部分を、
Declare PtrSafe Function SHGetFileInfo Lib "shell32.dll" ～～
のようにしてみて下さい。
（他にもあるかもしれませんが、ご提示の範囲内で…）

意味合いとしては、64ビット環境でdll等を使用する際の指定項目です。
https://docs.microsoft.com/ja-jp/office/vba/lang …

以下ご参考までに。
・Windows10でVBA(32bit)実行エラー「DeclareステートメントにPtrSafe属性～」対処法
https://eijiman.com/windows10-declare-ptrsafe/

この回答へのお礼

早速ご教示いただきありがとうございました。そういう現象だったのですね。
他にも4か所、サブルーチン？の部分で引っかかったのですが、以下の【PtrSafe】の書き方では合ってないようで、実行すると無限ループか何かで「応答なし」になってしまいます、何か記述にお心当たりありますでしょうか？


'[フォルダの参照]ダイアログを呼び出すAPI
Public Declare 【PtrSafe】 Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBROWSEINFO As BROWSEINFO) As Long

'SHBrowseForFolderで得られた値からフォルダのパスを取得するAPI
Public Declare 【PtrSafe】 Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

'ウィンドウハンドルを返す
Declare 【PtrSafe】 Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long

'SHBrowseForFolderで得られた値のメモリを開放するAPI
Public Declare 【PtrSafe】 Function SHFree Lib "shell32" Alias "#195" _
(ByVal pidl As Long) As Long

お礼日時：2021/05/31 00:09