64位Excel中VBA Ping模块函数声明报错：仅注释可在End Function后

嘿，我一眼就揪出问题所在了——你的条件编译语句结构犯了语法错误，这才导致了那个弹窗提示！

问题根源 #

你把#End If放在了32位分支的Ping函数内部（WSACleanup之后、End Function之前），但VBA的规则是：#If...#End If必须是完整的配对结构，而且绝对不能出现在函数/过程的代码块里面。

至于为什么忽略错误后功能还能正常运行？那只是VBA编译时“睁一只眼闭一只眼”跳过了错误部分，但这种结构有潜在的稳定性风险，必须修正。

修正后的完整代码 #

正确的做法是让#If Win64 Then和#Else各自包裹完整的函数声明+函数体（包括End Function），最后把#End If放在所有代码的末尾：

#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 Function
#End If

核心修正说明 #

1. 条件编译范围调整：每个分支（64位/32位）都包含完整的API声明和Ping函数（从Public Function到End Function），确保代码块独立且完整。
2. #End If位置修正：把#End If移到两个版本的Ping函数之后，和开头的#If Win64 Then正确配对，彻底避免了“代码出现在End Function之后”的语法错误。

修改后再打开工作簿，就不会再弹出错误提示，而且32位和64位环境下的Ping功能都能稳定运行。

内容的提问来源于stack exchange，提问作者Proximus Seraphim Dimitri Davi