代码不适用于64位Office

时间:2014-02-24 08:40:20

标签: excel excel-vba vba

我应该弄清楚64位系统上excel VBA代码兼容性的问题。我不使用VB语言,下面的代码不是我的,但我必须解决这个问题。

Excel VB代码:

Option Explicit

Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Byte, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByRef lpUsedDefaultChar As Long) As Long

Private Const CP_UTF8 As Long = 65001
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122&


Public Function ToUTF8(s As String) As Byte()

  If Len(s) = 0 Then Exit Function


  Dim ccb As Long
  ccb = WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), ByVal 0&, 0, vbNullString, ByVal 0&)

  If ccb = 0 Then
    Err.Raise 5, , "Internal error."
  End If

  Dim b() As Byte
  ReDim b(1 To ccb)

  If WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), b(LBound(b)), ccb, vbNullString, ByVal 0&) = 0 Then
    Err.Raise 5, , "Internal error."
  Else
    ToUTF8 = b
  End If

End Function

我尝试向所有地方添加条件#If VBA7PtrSave,但工作表仍无效。

这是我在Office 64位中尝试的代码

    Option Explicit

    #If VBA7 Then
    Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Integer, ByVal dwFlags As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As LongPtr
    #Else
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Byte, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByRef lpUsedDefaultChar As Long) As Long
    #EndIf

    Private Const CP_UTF8 As Long = 65001
    Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122&


    Public Function ToUTF8(s As String) As Byte()

      If Len(s) = 0 Then Exit Function


      Dim ccb As LongPtr
      ccb = WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), ByVal 0&, 0, vbNullString, ByVal 0&)

      If ccb = 0 Then
        Err.Raise 5, , "Internal error."
      End If

      Dim b() As Byte
      ReDim b(1 To ccb) // ERROR TYPE MISMATCH on ccb

      If WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), b(LBound(b)), ccb, vbNullString, ByVal 0&) = 0 Then
        Err.Raise 5, , "Internal error."
      Else
        ToUTF8 = b
      End If

    End Function

感谢您的帮助。

1 个答案:

答案 0 :(得分:2)

(未测试的)

更改


Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" _
(ByVal CodePage As Integer, ByVal dwFlags As Long, ByVal lpWideCharStr _
As LongPtr, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, _
ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long) As LongPtr

Private Declare PtrSafe Function WideCharToMultiByte Lib "Kernel32" ( _
ByVal CodePage As LongPtr, ByVal dwflags As LongPtr, _
ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, _
ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, _
ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As LongPtr

Private Const CP_UTF8 As Long = 65001

Private Const CP_UTF8 = 65001

这个

Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122&

Private Const ERROR_INSUFFICIENT_BUFFER = 122&

Dim ccb As LongPtr

Dim ccb As Variant

在我建议的最后三个章节中,我们将它们声明为变体,因为我们不知道不同系统上的类型。它可以是LongLongPtr