所以我必须在函数调用之前加入PtrSafe，因为我现在使用的是64位Excel。到目前为止，除PtrSafe之外，mod_Ping更改工作正常。我必须执行#If Win64 Then ... #else ... #end if语句才能使此代码在我的宏中运行，因为如果我刚刚添加到{{1}中，它将不适用于此部分在每个函数调用之前。
PtrSafe正如您所看到的，我还必须将长片更改为#If Win64 Then
Private Declare PtrSafe Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As LongPtr
Private Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As LongPtr
Private Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As LongPtr)
Private Declare PtrSafe Function IcmpCreateFile Lib "icmp.dll" () As LongPtr
Private Declare PtrSafe Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As LongPtr) As Boolean
Private Declare PtrSafe Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As LongPtr, ByVal DestAddress As LongPtr, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As LongPtr, ByVal Timeout As LongPtr) As Boolean
Public Function Ping(sAddr As String, Optional Timeout As Integer = 2000) As Integer
Dim hFile As LongPtr, lpWSAdata As WSAdata
Dim hHostent As Hostent, AddrList As LongPtr
Dim Address As LongPtr, rIP As String
Dim OptInfo As IP_OPTION_INFORMATION
Dim EchoReply As IP_ECHO_REPLY
Call WSAStartup(&H101, lpWSAdata)
If GetHostByName(sAddr + String(64 - Len(sAddr), 0)) <> SOCKET_ERROR Then
CopyMemory hHostent.h_name, ByVal GetHostByName(sAddr + String(64 - Len(sAddr), 0)), Len(hHostent)
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
CopyMemory Address, ByVal AddrList, 4
End If
hFile = IcmpCreateFile()
If hFile = 0 Then
Ping = -2 ' MsgBox "Unable to Create File Handle"
Exit Function
End If
OptInfo.TTL = 255
If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, Timeout) Then
rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
Else
Ping = -1 ' MsgBox "Timeout"
End If
If EchoReply.Status = 0 Then
Ping = EchoReply.RoundTripTime
Else
Ping = -3
End If
IcmpCloseHandle hFile
WSACleanup
End Function
#Else
Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal Timeout As Long) As Boolean
Public Function Ping(sAddr As String, Optional Timeout As Integer = 2000) As Integer
Dim hFile As Long, lpWSAdata As WSAdata
Dim hHostent As Hostent, AddrList As Long
Dim Address As Long, rIP As String
Dim OptInfo As IP_OPTION_INFORMATION
Dim EchoReply As IP_ECHO_REPLY
Call WSAStartup(&H101, lpWSAdata)
If GetHostByName(sAddr + String(64 - Len(sAddr), 0)) <> SOCKET_ERROR Then
CopyMemory hHostent.h_name, ByVal GetHostByName(sAddr + String(64 - Len(sAddr), 0)), Len(hHostent)
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
CopyMemory Address, ByVal AddrList, 4
End If
hFile = IcmpCreateFile()
If hFile = 0 Then
Ping = -2 ' MsgBox "Unable to Create File Handle"
Exit Function
End If
OptInfo.TTL = 255
If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, Timeout) Then
rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
Else
Ping = -1 ' MsgBox "Timeout"
End If
If EchoReply.Status = 0 Then
Ping = EchoReply.RoundTripTime
Else
Ping = -3
End If
IcmpCloseHandle hFile
WSACleanup
#End If
End Function
。
当我打开这本工作簿时，它给出了错误，只有在结束子结束函数或结束属性后才会出现注释。奇怪的是，如果我只是忽略它并关闭调试器，工作簿工作正常。
我的意思是LongPtr应该在那里结束最初的#End if调用，所以我不知道为什么我会收到编译错误。有没有我没看到的东西？
答案 0 :(得分：1)
我认为我们的问题是 32bit Excel将数据类型Integer更改为Long数据类型。
尝试将Integer替换为LongPtr。
Long仅适用于 32位 Excel LongLong仅适用于 64位 Excel LongPtr适用于 32位和 64位