【源码】声明32位和64位Access、Excel等VBA兼容的API函数的方法

盗梦

1.在声明中加上  PtrSafe 关键字
2.加上VBA7 及Win64的判断
Declare 语句 PtrSafe 关键字（可参考VBA帮助）
带有 PtrSafe 关键字的 Declare 语句为建议的语法。要使包括 PtrSafe 的 Declare 语句能同时在 32 位和 64 位平台上的 VBA7 开发环境中正确运行，必须先将 Declare 语句中所有需要存储 64 位数的数据类型（参数和返回值）更新为使用 LongLong（对于 64 位整数）或 LongPtr（对于指针和句柄）。为确保与 VBA 版本 6 和更早版本的向后兼容性，请使用下面的构造：

#If Vba7 Then
Declare PtrSafe Sub...
#Else
Declare Sub...
#EndIf


示例1：

1. #If VBA7 Then  ' 64位
   
2.     Private Declare PtrSafe Function apisndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
   
3.     Private Declare PtrSafe Function apiPlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
   
4. #Else
   
5.     Private Declare Function apisndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
   
6.     Private Declare Function apiPlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
   
7. #End If

复制代码

'声明32位和64位Access Excel等VBA兼容的API函数

1. '当VBA7和Win64都是True时(只有64的Excel才是这种情况)，使用第一条Declare语句。在其他版本中，使用第二条Declare语句
   
2. #If VBA7 And Win64 Then
   
3.     Declare ptSafe Function GetWindowsDirectory Lib "kernel32" (ByVal ipBuffer As String, ByVal nSize As Long) As Long
   
4. #Else
   
5.     Declare Function GetWindowsDirectory Lib "kernel32" (ByVal ipBuffer As String, ByVal nSize As Long) As Long
   
6. #End If
   
7. 
   
8. GetWindowsDirectory()
   
9. 说明
   
10. 这个函数能获取Windows目录的完整路径名。在这个目录里，保存了大多数windows应用程序文件及初始化文件
    
11. 返回值
    
12. Long类型，复制到lpBuffer的一个字串的长度。如lpBuffer不够大，不能容下整个字串，就会返回lpBuffer要求的长度，零表示失败。并且将出错的信息存储在GetLastError函数中，用户可以通过调用GetLastError来得到错误信息。
    
13. 参数表
    
14. 参数 类型及说明
    
15. lpBuffer String，指定一个字串缓冲区，用于装载Windows目录名。除非是根目录，否则目录中不会有一个中止用的“\”字符
    
16. nSize Long，lpBuffer字串的最大长度
    
17. ​'获取Windows文件夹路径
    
18. privateDeclare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long'在form窗体中声明改函数
    
19. Dim SWinDir As String '定义字符变量用来存储路径
    
20. Dim Retn As Long ‘定义长整型变量存储路径的长度
    
21. SWinDir = Space(255)’设定一个空串，长度为windows允许的最大长度，也可写作：SWidir=String(255,0)
    
22. Retn = GetWindowsDirectory(SWinDir, Len(SWinDir))‘获取windows路径的长度，swindir存储了路径
    
23. SWinDir = Left(SWinDir, Retn)’去掉空白内容。

复制代码

示例2

1. #If VBA7 Then
   
2. '定义窗体样式
   
3. Private Declare PtrSafe Function FindWindow Lib "user32" Alias _
   
4.     "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
5. Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias _
   
6.     "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
7. #Else
   
8. '定义窗体样式
   
9. Private Declare Function FindWindow Lib "user32" Alias _
   
10.     "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
11. Private Declare Function SetWindowLong Lib "user32" Alias _
    
12.     "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
13. #End If
    
14. 经过以上处理， 在office2003、2007和2010版本 office2013、xp以上系统均可正常运行。
    

复制代码

示例3

1. If VBA7Then
   
2.     Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongLong
   
3.     Public Declare PtrSafe Function ClientToScreen Lib "user32" (ByVal hWnd As LongLong, lpPoint As POINTAPI) As LongLong
   
4.     Public Popup_Menu       As CommandBar       '指定弹出式菜单
   
5.     Public LastSelect_Menu  As MSForms.Image    '最后选择的菜单
   
6.     Public MenuCount        As Integer          '子菜单数量
   
7.     Public hForm            As Long             '窗口句柄
   
8.     Public intLevel         As Integer          '级别标识,用于设置Radio菜单(游戏菜单中:初级,中级,高级)
   
9.     Public bAbortEnabled    As Boolean          '标识放弃菜单项是否可用
   
10.     Public bItemCheck       As Boolean          '标识音效菜单是否CheckOn
    
11.     Public bMenuSelected    As Boolean          '标识菜单是否点击
    
12.     Public pt               As POINTAPI         '定义点
    
13.     Public faceid As Integer                    '图标ID
    
14.     Public faceidselect As Integer              '选择的图标
    
15.     Public fistid As Integer                    '第一个图标号
    
16.     Public lastid As Integer                    '最后一个图标号
    
17.     Public selectrow, selectcol As Integer
    
18.     Public Mcro(50) As String
    
19.     Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongLong, ByVal nIndex As LongLong) As LongLong
    
20.     Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongLong, ByVal nIndex As LongLong, ByVal dwNewLong As LongLong) As LongLong
    
21.     Public Const GWL_STYLE = (-16)
    
22.     Public Const WS_THICKFRAME As Long = &H40000     '(回復大小)
    
23.     Public Const WS_MINIMIZEBOX As Long = &H20000    '(最小化)
    
24.     Public Const WS_MAXIMIZEBOX As Long = &H10000    '(最大化)
    
25. Else
    
26.     Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
27.     Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
    
28.     Public Popup_Menu       As CommandBar       '指定弹出式菜单
    
29.     Public LastSelect_Menu  As MSForms.Image    '最后选择的菜单
    
30.     Public MenuCount        As Integer          '子菜单数量
    
31.     Public hForm            As Long             '窗口句柄
    
32.     Public intLevel         As Integer          '级别标识,用于设置Radio菜单(游戏菜单中:初级,中级,高级)
    
33.     Public bAbortEnabled    As Boolean          '标识放弃菜单项是否可用
    
34.     Public bItemCheck       As Boolean          '标识音效菜单是否CheckOn
    
35.     Public bMenuSelected    As Boolean          '标识菜单是否点击
    
36.     Public pt               As POINTAPI         '定义点
    
37.     Public faceid As Integer                    '图标ID
    
38.     Public faceidselect As Integer              '选择的图标
    
39.     Public fistid As Integer                    '第一个图标号
    
40.     Public lastid As Integer                    '最后一个图标号
    
41.     Public selectrow, selectcol As Integer
    
42.     Public Mcro(50) As String
    
43.     Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    
44.     Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
45.     Public Const GWL_STYLE = (-16)
    
46.     Public Const WS_THICKFRAME As Long = &H40000     '(回復大小)
    
47.     Public Const WS_MINIMIZEBOX As Long = &H20000    '(最小化)
    
48.     Public Const WS_MAXIMIZEBOX As Long = &H10000    '(最大化)
    
49. End If

复制代码

盗梦

微软的相关64位与32位兼容性的文章32 位和 64 位版本的 Office 2010 之间的兼容性Office 2010

摘自：https://msdn.microsoft.com/zh-cn/library/ee691831.aspx

摘要：针对处理大量数据的客户，Microsoft 推出了 64 位版本的 Microsoft Office 2010。本文讨论有关 32 位版本与新的 64 位版本和旧的 32 位 Office 应用程序之间兼容性的问题，并提供了相应的解决方案。（12 个打印页）

上次修改时间： 2011年4月7日

Microsoft Corporation 的 Frank Rice

本文内容
介绍 32 位和 64 位版本的 Microsoft Office 2010
将 32 位系统与 64 位系统进行比较
介绍 VBA 7 基本代码
ActiveX 控件和 COM 加载项兼容性
应用程序编程接口兼容性
使用条件编译属性
结论
其他资源

2009 年 11 月

适用范围： Excel 2010 | Office 2007 | Office 2010 | Open XML | PowerPoint 2010 | SharePoint Server 2010 | VBA | Visual Basic for Applications 7.0 (VBA 7.0) | Word 2010

内容

• 介绍 32 位和 64 位版本的 Microsoft Office 2010

• 将 32 位系统与 64 位系统进行比较

• 介绍 VBA 7 基本代码

• ActiveX 控件和 COM 加载项兼容性

• 应用程序编程接口兼容性

• 使用条件编译属性

• 结论

• 其他资源

  
  

[url=]介绍 32 位和 64 位版本的 Microsoft Office 2010[/url]

Microsoft Office 2010 system 同时具有 32 位和 64 位版本。64 位版本使您能够处理更大的数据集。如果要在 Microsoft Excel 2010 中处理大量数字，则尤其需要使用此版本。

随着新的 64 位版本 Microsoft Office 2010 的引入，Microsoft 发布了称为 Microsoft Visual Basic for Applications 7.0 (VBA 7) 的新版本的 Microsoft Visual Basic for Applications (VBA) 以同时处理 32 位和 64 位应用程序。需要特别注意的是，本文中介绍的更改只适用于 64 位版本的 Microsoft Office 2010。如果使用的是 32 位版本的 Office 2010，则可以不加修改地使用以前版本的 Microsoft Office 中内置的解决方案。

注释

在安装 Office 2010 时，默认安装的是 32 位版本，即使在 64 位系统上也是如此。您必须明确 选择 Office 2010 64 位版本安装选项。

在 VBA 7 中，必须更新现有 Windows 应用程序编程接口 (API) 语句（Declare 语句）才能处理 64 位版本。另外，还必须更新这些语句使用的用户定义类型中的地址指针和显示窗口句柄。本文将详细讨论这一点以及 32 位和 64 位版本的 Office 2010 之间的兼容性问题，并提供建议的解决方案。

[url=]将 32 位系统与 64 位系统进行比较[/url]

使用 64 位版本的 Office 2010 构建的应用程序可以引用更大的地址空间，因此提供了使用比以往更多的物理内存的机会，从而有可能减少将数据移入和移出物理内存所需的开销。

除了引用应用程序用于存储数据或存储编程指令的物理内存中的特定位置（又称为指针）外，还可以使用地址来引用显示窗口标识符（称为句柄）。根据您使用的是 32 位系统还是 64 位系统，可确定指针或句柄的大小（以字节为单位）。

在使用 64 位版本的 Office 2010 运行现有解决方案时存在两个基本问题：

• Office 2010 中的本机 64 位进程无法加载 32 位二进制文件。在使用现有 Microsoft ActiveX 控件和现有加载项时，这被认为是一个常见问题，

• VBA 以前不具有指针数据类型，因此，开发人员使用 32 位变量来存储指针和句柄。但现在在使用 Declare 语句时，这些变量会截断 API 调用返回的 64 位值。

  
  

[url=]介绍 VBA 7 基本代码[/url]

VBA 7 是新的基本代码，取代了早期版本的 VBA。32 位和 64 位版本的 Office 2010 中均包含 VBA 7。它提供了两个条件编译常量：VBA7 和 Win64。通过测试您的应用程序使用的是 VBA 7 还是以前版本的 VBA，VBA7 常量可帮助确保您的代码的后向兼容性。Win64 常量用于测试代码是以 32 位还是 64 位形式运行的。下文将介绍这两个编译常量。

[url=]ActiveX 控件和 COM 加载项兼容性[/url]

第三方及 Microsoft 提供的现有 32 位 ActiveX 控件与 64 位版本的 Office 2010 不兼容。对于 ActiveX 控件和 COM 对象，有三种可能的解决方案：

• 如果您有源代码，则可以自己生成 64 位版本，

• 您可以与供应商联系以获取更新版本，

• 也可以搜索其他解决方案。

  
  

[url=]
[/url]

盗梦

[url=]应用程序编程接口兼容性[/url]

VBA 和类型库的结合为您提供了许多用于创建 Microsoft Office 应用程序的功能。不过，有时，您必须直接与计算机的操作系统及其他组件进行通信，例如在您管理内存或进程时，在使用用户界面（例如窗口和控件）时，或在修改 Windows 注册表时。在这些情况下，最好选择使用一个嵌入动态链接库 (DLL) 文件中的外部函数。为此，可在 VBA 中使用 Declare 语句进行 API 调用。

注释

Microsoft 提供了一个 Win32API.txt 文件，其中包含 1,500 个 Declare 语句以及一个用于剪切所需 Declare 语句并将其粘贴到您的代码中的工具。不过，这些语句适用于 32 位系统，必须使用下文讨论的信息将其转换为 64 位。您可以在 Excel MVP Jan Karel Pieterse 的网站 http://www.jkp-ads.com/articles/apideclarations.asp（该链接可能指向英文页面） 上找到此类型的转换示例。

Declare 语句类似于以下代码之一，具体取决于您调用的是子例程（没有返回值）还是函数（有返回值）。

[size=1em][url=]VBA[/url]



Public/Private Declare Sub SubName Lib "LibName" Alias "AliasName" (argument list)Public/Private Declare Function FunctionName Lib "Libname" alias "aliasname" (argument list) As Type

SubName 函数或 FunctionName 函数会被替换为 DLL 文件中过程的实际名称，表示在从 VBA 代码调用过程时所使用的名称。如果需要，您还可以为过程名称指定AliasName 参数。包含要调用的过程的 DLL 文件的名称位于 Lib 关键字之后。最后，参数列表将包含必须传递给该过程的参数和数据类型。

下面的 Declare 语句将打开 Windows 注册表中的一个子项 并替换其值。

[size=1em][url=]VBA[/url]



Declare Function RegOpenKeyA Lib "advapi32.dll" (ByVal Key As Long, ByVal SubKey As String, NewKey As Long) As Long

RegOpenKeyA 函数的 Windows.h（窗口句柄）条目如下所示：

[size=1em][url=]VBA[/url]



LONG RegOpenKeyA ( HKEY hKey, LPCSTR lpSubKey, HKEY *phkResult );

在 Microsoft Visual C 和 Microsoft Visual C++ 中，前面的示例对 32 位和 64 位都能够正确编译。这是因为 HKEY 定义为指针，其大小反映了在其中编译代码的平台的内存大小。

在以前版本的 VBA 中，没有特定指针数据类型，因此使用了 Long 数据类型，而 Long 数据类型始终为 32 位，所以它在具有 64 位内存的系统上使用时会发生中断，因为前 32 位可能被截断或可能覆盖其他内存地址。以上任一情况都会导致不可预测的行为或系统崩溃。

为解决此问题，VBA 现在包含真正的指针 数据类型 LongPtr。此新数据类型使您能够正确编写原始 Declare 语句，如下所示：

[size=1em][url=]VBA[/url]



Declare PtrSafe Function RegOpenKeyA Lib "advapire32.dll" (ByVal hKey as LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As Long

此数据类型和新的 PtrSafe 属性使您能够在 32 位或 64 位系统上使用此 Declare 语句。PtrSafe 属性向 VBA 编译器指示 Declare 语句面向 64 位版本的 Office 2010。如果不使用此属性，那么在 64 位系统中使用 Declare 语句会导致编译时错误。请注意，PtrSafe 属性在 32 位版本的 Office 2010 上是可选的。因此现有 Declare 语句始终能够正常运行。

下表提供了有关已讨论过的新限定符和数据类型以及另一种数据类型、两个转换运算符和三个函数的详细信息。

类型	项	说明
限定符	PtrSafe	指示 Declare 语句与 64 位兼容。此属性在 64 位系统上是必需的。
数据类型	LongPtr	一种变量数据类型，在 32 位版本的 Office 2010 上是 4 字节数据类型，在 64 位版本上是 8 字节数据类型。这是为新代码声明指针或句柄的推荐方法，但如果它必须运行在 64 位版本的 Office 2010 中，则也为旧代码声明指针或句柄。只有 32 位和 64 位上的 VBA 7 运行时支持此数据类型。请注意，您可以为它赋予数值，但不能赋予数值类型。
数据类型	LongLong	这是只能在 64 位版本的 Office 2010 中使用的 8 字节数据类型。您可以赋予数值，但不能赋予数值类型（以避免截断）。
转换运算符	CLngPtr	将简单表达式转换为 LongPtr 数据类型。
转换运算符	CLngLng	将简单表达式转换为 LongLong 数据类型。
函数	VarPtr	变量转换器。在 64 位版本上返回 LongPtr，在 32 位版本上返回 Long（4 字节）。
函数	ObjPtr	对象转换器。在 64 位版本上返回 LongPtr，在 32 位版本上返回 Long（4 字节）。
函数	StrPtr	字符串转换器。在 64 位版本上返回 LongPtr，在 32 位版本上返回 Long（4 字节）。

盗梦

下面的示例演示如何在 Declare 语句中使用其中某些项。
VBA
Declare PtrSafe Function RegOpenKeyA Lib "advapi32.dll" (ByVal Key As LongPtr, ByVal SubKey As String, NewKey As LongPtr) As Long
请注意，没有 PtrSafe 属性的 Declare 语句被假定为与 64 位版本的 Office 2010 不兼容。
如前所述，有两个新的条件编译常量：VBA7 和 Win64。为确保与以前版本的 Office 的向后兼容性，可使用 VBA7 常量（这是较典型的情况）来防止 64 位代码在早期版本的 Office 中运行。对于在 32 位版本和 64 位版本之间有所不同的代码（例如调用数学 API，它对其 64 位版本使用 LongLong，对其 32 位版本使用 Long），可使用 Win64 常量。下面的代码演示如何使用这两个常量。
VBA
#if Win64 then
   Declare PtrSafe Function MyMathFunc Lib "User32" (ByVal N As LongLong) As LongLong
#else
   Declare Function MyMathFunc Lib "User32" (ByVal N As Long) As Long
#end if
#if VBA7 then
   Declare PtrSafe Sub MessageBeep Lib "User32" (ByVal N AS Long)
#else
   Declare Sub MessageBeep Lib "User32" (ByVal N AS Long)
#end if
总而言之，如果您编写 64 位代码并打算在以前版本的 Microsoft Office 中使用它，则需要使用 VBA7 条件编译常量。不过，如果您在 Office 2010 中编写 32 位代码，则该代码的工作方式与在以前版本的 Microsoft Office 中一样，无需使用编译常量。如果希望确保对 32 位版本使用 32 位语句，对 64 位版本使用 64 位语句，则最好选择使用Win64 条件编译常量。
使用条件编译属性

下面的代码是需要更新的旧 VBA 代码的示例。请注意旧代码中更新为使用 LongPtr 的数据类型，因为它们引用句柄或指针
旧 VBA 代码
VBA
Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  
Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
新 VBA 代码
VBA
#if VBA7 then    ' VBA7
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO
  hOwner As LongPtr
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As LongPtr
  lParam As LongPtr
  iImage As Long
End Type

#else    ' Downlevel when using previous version of VBA7

Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

#end if
Sub TestSHBrowseForFolder ()
    Dim bInfo As BROWSEINFO
    Dim pidList As Long

    bInfo.pidlRoot = 0&
    bInfo.ulFlags = &H1
    pidList = SHBrowseForFolder(bInfo)
End Sub
结论

增加了 64 位版本的 Office 2010 后，您可以移动更多数据来增强功能。编写 32 位代码时，可以使用 64 位版本的 Microsoft Office 而无需进行任何更改。不过，在编写 64 位代码时，应确保您的代码包含特定关键字和条件编译常量，以确保代码与早期版本的 Microsoft Office 向后兼容，并确保在混合 32 位和 64 位代码时执行了正确的代码

34acc

记号

土豆的爱

有用！！！感谢