VBA检测WiFi/以太网连接并跳转幻灯片问题求助（附无效代码）

问题背景 #

开发一款带更新功能的操作系统配套演示，需通过VBA检测设备是否通过WiFi/以太网建立有效互联网连接：

• 检测成功：跳转至幻灯片3
• 检测失败：跳转至幻灯片2

现有代码无法正常运行，原代码如下：

Private Function IsInternetConnected(Optional SupressMessage As Boolean) As Boolean

Dim objHTTP As Object

'Test for Internet Connection
  If IsInternetConnected = True Then
  ActivePresentation.SlideShowWindow.View.GotoSlide 3
End

'Report to User if Internet Connection not detected
  If IsInternetConnected = False And SupressMessage = False Then
    ActivePresentation.SlideShowWindow.View.GotoSlide 2
  End If

End Function

原代码问题分析 #

1. 无实际检测逻辑：函数未实现任何互联网连接检测的代码，直接判断自身默认返回值（False），逻辑完全无效
2. 语法错误：第一个If语句用End替代End If，会导致编译报错
3. 逻辑顺序颠倒：未执行检测就判断结果，逻辑流程完全错误

修复后的完整代码 #

Private Function IsInternetConnected(Optional SupressMessage As Boolean) As Boolean
    Dim objHTTP As Object
    Dim isConnected As Boolean
    
    ' 初始化连接状态为未连接
    isConnected = False
    
    ' 创建HTTP对象（后期绑定，无需额外引用）
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    On Error Resume Next ' 捕获网络请求错误
    ' 请求微软官方检测地址，验证真实互联网连接
    objHTTP.Open "GET", "http://www.msftconnecttest.com/connecttest.txt", False
    objHTTP.Send
    
    ' 验证请求是否成功且返回内容符合预期
    If Err.Number = 0 And objHTTP.Status = 200 And objHTTP.ResponseText = "Microsoft Connect Test" Then
        isConnected = True
    End If
    On Error GoTo 0 ' 恢复默认错误处理
    
    ' 根据连接状态执行幻灯片跳转
    If isConnected Then
        ActivePresentation.SlideShowWindow.View.GotoSlide 3
    ElseIf Not SupressMessage Then
        ActivePresentation.SlideShowWindow.View.GotoSlide 2
    End If
    
    ' 返回最终连接状态
    IsInternetConnected = isConnected
    Set objHTTP = Nothing
End Function

关键说明 #

• 有效连接验证：通过请求微软官方检测地址，确保设备不是仅处于局域网，而是能正常访问互联网
• 错误防护：加入错误捕获处理网络请求时的异常（如DNS失败、超时等）
• 语法与逻辑修正：修复原代码语法错误，调整为「先检测再判断跳转」的正确流程
• 兼容性优化：使用后期绑定创建HTTP对象，无需手动添加MSXML2库引用

使用方式 #

在幻灯片放映触发事件中调用该函数即可，例如：

Private Sub SlideShowBegin(ByVal Wn As SlideShowWindow)
    IsInternetConnected
End Sub

内容的提问来源于stack exchange，提问作者Tzipirigu Mic