问题描述

我尝试让代码在 64 位 VBA 下工作，这在 32 位 VBA 下工作正常。

它是关于通用控件任务对话框的。

我使用 Microsoft Access，但其他 VBA 主机中的问题应该是相同的。

一部分在（32 位和 64 位）VBA 中都可以正常工作，而另一部分则不能。

`TaskDialog`API 在（32 位和 64 位）VBA 中运行良好

您可以启动TestTaskDlg测试程序。

Option Explicit

'Original API definition:
'------------------------
'HRESULT TaskDialog(
'  HWND                           hwndOwner,
'  HINSTANCE                      hInstance,
'  PCWSTR                         pszWindowTitle,
'  PCWSTR                         pszMainInstruction,
'  PCWSTR                         pszContent,
'  TASKDIALOG_COMMON_BUTTON_FLAGS dwCommonButtons,
'  PCWSTR                         pszIcon,
'  int                            *pnButton
');
Private Declare PtrSafe Function TaskDialog Lib "Comctl32.dll" _
                            (ByVal hWndParent As LongPtr, _
                             ByVal hInstance As LongPtr, _
                             ByVal pszWindowTitle As LongPtr, _
                             ByVal pszMainInstruction As LongPtr, _
                             ByVal pszContent As LongPtr, _
                             ByVal dwCommonButtons As Long, _
                             ByVal pszIcon As LongPtr, _
                             ByRef pnButton As Long _
                             ) As Long

'Works fine with 32-Bit VBA and 64-Bit VBA:
Public Sub TestTaskDlg()
    Debug.Print TaskDlg("Title", "MainInstructionText", "ContentText")
End Sub

Public Function TaskDlg( _
                    sWindowTitle As String, _
                    sMainInstruction As String, _
                    sContent As String _
                    ) As Long

    On Local Error GoTo Catch

    Dim clickedButton As Long
    TaskDlg = TaskDialog(0, _
                0, _
                StrPtr(sWindowTitle), _
                StrPtr(sMainInstruction), _
                StrPtr(sContent), _
                0, _
                0, _
                clickedButton)

    Debug.Print "Clicked button:", clickedButton

Done:
    Exit Function

Catch:
    MsgBox Err.Description, , Err.Number
    Resume Done
End Function

`TaskDialogIndirect`API 仅在 32 位 VBA 中运行良好

您可以启动TestTaskDlgIndirect测试程序。

在 64 位 VBA 中，它返回E_INVALIDARG (0x80070057 | -2147024809)，以某种方式指向无效参数...

如果我使用Len()代替LenB()并注释这三行代码，它会显示一个正确的（空）对话框，因此调用TaskDialogIndirect应该是正确的。

tdlgConfig.pszWindowTitle = StrPtr(sWindowTitle)
tdlgConfig.pszMainInstruction = StrPtr(sMainInstruction)
tdlgConfig.pszContent = StrPtr(sContent)

有人知道为什么它不能在 64 位 VBA 中工作吗？

在我看来，我已经将类型从正确转换Long为LongPtr。

我希望这是在运行时存储在结构中的值/指针的问题。

也许一些高/低字节的东西？

任何帮助表示赞赏。:-)

Option Explicit

'Original API definition:
'------------------------
'typedef struct _TASKDIALOGCONFIG {
'  UINT                           cbSize;
'  HWND                           hwndParent;
'  HINSTANCE                      hInstance;
'  TASKDIALOG_FLAGS               dwFlags;
'  TASKDIALOG_COMMON_BUTTON_FLAGS dwCommonButtons;
'  PCWSTR                         pszWindowTitle;
'  union {
'    HICON  hMainIcon;
'    PCWSTR pszMainIcon;
'  } DUMMYUNIONNAME;
'  PCWSTR                         pszMainInstruction;
'  PCWSTR                         pszContent;
'  UINT                           cButtons;
'  const TASKDIALOG_BUTTON        *pButtons;
'  int                            nDefaultButton;
'  UINT                           cRadioButtons;
'  const TASKDIALOG_BUTTON        *pRadioButtons;
'  int                            nDefaultRadioButton;
'  PCWSTR                         pszVerificationText;
'  PCWSTR                         pszExpandedInformation;
'  PCWSTR                         pszExpandedControlText;
'  PCWSTR                         pszCollapsedControlText;
'  union {
'    HICON  hFooterIcon;
'    PCWSTR pszFooterIcon;
'  } DUMMYUNIONNAME2;
'  PCWSTR                         pszFooter;
'  PFTASKDIALOGCALLBACK           pfCallback;
'  LONG_PTR                       lpCallbackData;
'  UINT                           cxWidth;
'} TASKDIALOGCONFIG;
Public Type TASKDIALOGCONFIG
    cbSize As Long                                  'UINT
    hWndParent As LongPtr                           'HWND
    hInstance As LongPtr                            'HINSTANCE
    dwFlags As Long                                 'TASKDIALOG_FLAGS
    dwCommonButtons As Long                         'TASKDIALOG_COMMON_BUTTON_FLAGS
    pszWindowTitle As LongPtr                       'PCWSTR
'    Union
'    {
        hMainIcon As LongPtr                        'Union means that the biggest type has to be declared: So LongPtr
'       hMainIcon                                   'HICON
'       pszMainIcon                                 'PCWSTR
'    };
    pszMainInstruction As LongPtr                   'PCWSTR
    pszContent As LongPtr                           'PCWSTR
    cButtons As Long                                'UINT
    pButtons As LongPtr                             'TASKDIALOG_BUTTON  *pButtons;
    nDefaultButton As Long                          'INT
    cRadioButtons As Long                           'UINT
    pRadioButtons As LongPtr                        'TASKDIALOG_BUTTON  *pRadioButtons;
    nDefaultRadioButton As Long                     'INT
    pszVerificationText As LongPtr                  'PCWSTR
    pszExpandedInformation As LongPtr               'PCWSTR
    pszExpandedControlText As LongPtr               'PCWSTR
    pszCollapsedControlText As LongPtr              'PCWSTR
    'Union
    '{
        hFooterIcon As LongPtr                      'Union means that the biggest type has to be declared: So LongPtr
    '   hFooterIcon                                 'HICON
    '   pszFooterIcon                               'PCWSTR
    '};
    pszFooter As LongPtr                            'PCWSTR
    pfCallback As LongPtr                           'PFTASKDIALOGCALLBACK
    lpCallbackData As LongPtr                       'LONG_PTR
    cxWidth As Long                                 'UINT
End Type

'Original API definition:
'------------------------
'HRESULT TaskDialogIndirect(
'  const TASKDIALOGCONFIG *pTaskConfig,
'  int                    *pnButton,
'  int                    *pnRadioButton,
'  BOOL                   *pfVerificationFlagChecked
');
Private Declare PtrSafe Function TaskDialogIndirect Lib "Comctl32.dll" ( _
                            ByRef pTaskConfig As TASKDIALOGCONFIG, _
                            ByRef pnButton As Long, _
                            ByRef pnRadioButton As Long, _
                            ByRef pfVerificationFlagChecked As Long _
                            ) As Long

'Works fine with 32-Bit VBA. But with 64-Bit VBA it returns E_INVALIDARG (0x80070057 | -2147024809)
Public Sub TestTaskDlgIndirect()
    Debug.Print TaskDlgIndirect("Title", "MainInstructionText", "ContentText")
End Sub

Public Function TaskDlgIndirect( _
                    sWindowTitle As String, _
                    sMainInstruction As String, _
                    sContent As String _
                    ) As Long

    On Local Error GoTo Catch

    Dim tdlgConfig As TASKDIALOGCONFIG
    tdlgConfig.cbSize = LenB(tdlgConfig)

    'Usually LenB() should be the right way to use, but when I use Len() and comment the three texts below, it shows a proper empty dialog!
    tdlgConfig.pszWindowTitle = StrPtr(sWindowTitle)
    tdlgConfig.pszMainInstruction = StrPtr(sMainInstruction)
    tdlgConfig.pszContent = StrPtr(sContent)

    Dim clickedButton As Long
    Dim selectedRadio As Long
    Dim verificationFlagChecked As Long
    TaskDlgIndirect = TaskDialogIndirect(tdlgConfig, clickedButton, _
                        selectedRadio, verificationFlagChecked)

    Debug.Print "Clicked button:", clickedButton

Done:
    Exit Function

Catch:
    MsgBox Err.Description, , Err.Number
    Resume Done
End Function

更新

一些新的见解：

似乎在TASKDIALOGCONFIG内部使用了 1 字节的包装。

在 32 位 VBA（对结构使用 4 字节填充）中，这无关紧要，因为结构的所有成员都是类型Long，因此是 4 字节，所以根本没有发生填充。
同样在这个星座中， using 没有区别，Len(tdlgConfig)它只计算数据类型的总和，而LenB(tdlgConfig)，它确实计算了结构的实际大小。
两者都在这里产生 96 个字节。
但是在 64 位 VBA（对结构使用 8 字节填充）中，结构的某些成员是类型Long（4 字节），有些是LongLong（8 字节）（声明LongPtr为 32 位兼容性）。这导致 VBA 应用填充，这就是Len(tdlgConfig)返回160和LenB(tdlgConfig)176 的原因。
因此，因为我的测试没有提供任何文本（注释提到的 3 行代码）仅在我使用Len(tdlgConfig)（而不是LenB(tdlgConfig)）时才显示一个对话框，因此得出了相同的结论，即 64 位 API 只需要 160 字节的结构。

因此，为了提供一个 160 字节的结构，我将其用于测试：

Public Type TASKDIALOGCONFIG
    cbSize As Long
    dummy2 As Long
    dummy3 As Long
    dummy4 As Long
    dummy5 As Long
    dummy6 As Long
    dwCommonButtons As Long
    dummy8 As Long
    dummy9 As Long
    dummy10 As Long
    dummy11 As Long
    dummy12 As Long
    dummy13 As Long
    dummy14 As Long
    dummy15 As Long
    dummy16 As Long
    dummy17 As Long
    dummy18 As Long
    nDefaultButton As Long
    dummy20 As Long
    dummy21 As Long
    dummy22 As Long
    dummy23 As Long
    dummy24 As Long
    dummy25 As Long
    dummy26 As Long
    dummy27 As Long
    dummy28 As Long
    dummy29 As Long
    dummy30 As Long
    dummy31 As Long
    dummy32 As Long
    dummy33 As Long
    dummy34 As Long
    dummy35 As Long
    dummy36 As Long
    dummy37 As Long
    dummy38 As Long
    dummy39 As Long
    dummy40 As Long
End Type

现在两者都Len(tdlgConfig)返回LenB(tdlgConfig)160。

调用没有文本的空对话框仍然运行良好。

我现在可以设置dwCommonButtonsand nDefaultButton（两种类型Long），到目前为止它工作正常。

例如：

Public Enum TD_COMMON_BUTTON_FLAGS
    TDCBF_OK_BUTTON = &H1&               '// Selected control returns value IDOK
    TDCBF_YES_BUTTON = &H2&              '// Selected control returns value IDYES
    TDCBF_NO_BUTTON = &H4&               '// Selected control returns value IDNO
    TDCBF_CANCEL_BUTTON = &H8&           '// Selected control returns value IDCANCEL
    TDCBF_RETRY_BUTTON = &H10&           '// Selected control returns value IDRETRY
    TDCBF_CLOSE_BUTTON = &H20&           '// Selected control returns value IDCLOSE
End Enum
'typedef DWORD TASKDIALOG_COMMON_BUTTON_FLAGS;           // Note: _TASKDIALOG_COMMON_BUTTON_FLAGS is an int

Public Enum TD_COMMON_BUTTON_RETURN_CODES
    IDOK = 1
    IDCANCEL = 2
    IDRETRY = 4
    IDYES = 6
    IDNO = 7
    IDCLOSE = 8
End Enum

    tdlgConfig.dwCommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON
    tdlgConfig.nDefaultButton = IDNO

所以我可以预期结构的大小很好，现在我必须找出如何设置LongLong( LongPtr) 类型......

标签： vbaapi64-bitcomctl32

解决方案

最后，我开始在 64 位 VBA 中设置要使用的图标和结构中的字符串。

这是新的结构，我在其中命名了主图标和主指令文本的成员：

Public Type TASKDIALOGCONFIG
    cbSize As Long
    dummy2 As Long
    dummy3 As Long
    dummy4 As Long
    dummy5 As Long
    dummy6 As Long
    dwCommonButtons As Long
    dummy8 As Long
    dummy9 As Long
    hMainIcon1 As Long
    hMainIcon2 As Long
    pszMainInstruction1 As Long
    pszMainInstruction2 As Long
    dummy14 As Long
    dummy15 As Long
    dummy16 As Long
    dummy17 As Long
    dummy18 As Long
    nDefaultButton As Long
    dummy20 As Long
    dummy21 As Long
    dummy22 As Long
    dummy23 As Long
    dummy24 As Long
    dummy25 As Long
    dummy26 As Long
    dummy27 As Long
    dummy28 As Long
    dummy29 As Long
    dummy30 As Long
    dummy31 As Long
    dummy32 As Long
    dummy33 As Long
    dummy34 As Long
    dummy35 As Long
    dummy36 As Long
    dummy37 As Long
    dummy38 As Long
    dummy39 As Long
    dummy40 As Long
End Type

因为LongLong结构中的值现在都被拆分为单独的Long值，所以我无法以通用方式设置它们。

通过一些尝试和错误，我找到了一种设置图标的方法。Long以与在 32 位 VBA 中相同的方式设置第一个值就足够了：

Const TD_SECURITY_ICON_OK As Integer = -8

tdlgConfig.hMainIcon1 = &HFFFF And TD_SECURITY_ICON_OK

将指针设置为字符串也有点棘手。我终于声明了CopyMemoryAPI 子...

Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
    ByVal destination As LongPtr, _
    ByVal source As LongPtr, _
    ByVal dataLength As LongPtr)

...并像这样使用它在结构中设置字符串引用：

CopyMemory VarPtr(tdlgConfig.pszMainInstruction1), VarPtr(StrPtr("My main instruction")), 8

最后我可以使用这样的功能TaskDialogIndirect：

    Dim clickedButton As Long
    Dim selectedRadio As Long
    Dim verificationFlagChecked As Long
    Call TaskDialogIndirect(tdlgConfig, clickedButton, _
                        selectedRadio, verificationFlagChecked)

    Debug.Print "Clicked button:", clickedButton

剩下的就是设置其他文本等，并使用大小写区分使代码在 32 位和 64 位上可执行。

再次感谢 GSerg 的回复。

vba - 在 64 位 VBA 中使用 TaskDialogIndirect

问题描述

问题描述

`TaskDialog`API 在（32 位和 64 位）VBA 中运行良好

`TaskDialogIndirect`API 仅在 32 位 VBA 中运行良好

更新

解决方案

推荐阅读

vba - 在 64 位 VBA 中使用 TaskDialogIndirect

问题描述

问题描述

TaskDialogAPI 在（32 位和 64 位）VBA 中运行良好

TaskDialogIndirectAPI 仅在 32 位 VBA 中运行良好

更新

解决方案

推荐阅读

`TaskDialog`API 在（32 位和 64 位）VBA 中运行良好

`TaskDialogIndirect`API 仅在 32 位 VBA 中运行良好