VBA 判断是否可以访问网络（互联网 局域网)

seeyoutime

VBA 判断是否可以访问网络（互联网 局域网)

方法一： API方式
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(lpdwFlags As Long, ByVal dwReserved As Long) As Long '申明API


Sub net()
    Dim netweb As Long
    If InternetGetConnectedState(netweb, 0) <> 0 Then
       MsgBox "可以"
    Else
       MsgBox "不可以"
    End If
End Sub


方法二：XMLHTTP
Sub net()
Dim xml6 As Object
Set xml6 = CreateObject("Microsoft.XMLHTTP")
URL = "http://chiensq.blog.163.com"
xml6.Open "GET", URL, False
xml6.Send
  If xml6.Status = 200 Then
    MsgBox "可以"
  Else
    MsgBox "不可以"
  End If
End Sub


方法三：ping
Public Function Pings(strMachines As String) As Boolean
aMachines = Split(strMachines, ";")
For Each machine In aMachines     Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select *
_
    from Win32_PingStatus where address = '" & machine & "'")
    For Each objStatus In objPing
        If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
            Debug.Print ("machine " & machine & " is not reachable")
            Pings = False
        Else
            Pings = True
        End If
    Next
Next
End Function


方法四：shell
Sub Chksys()
Dim  oExec
oExec = CreateObject("Wscript.shell").Run("ping chiensq.blog.163.com -n 1", 0, True)
  If oExec = 0 Then
    msgbox "可以"
  Else
    msgbox"不可以"
  End If
End Sub


方法五：局域网
Sub net()
Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists("\\172.20.31.32\123\ver.txt") Then '文件夹FSO.folderexists(“\\172.20.31.32\123”)
        MsgBox "存在"
    Else
        MsgBox "不存在"
    End If
    Set fso = Nothing
End Sub

liucqa

取HEAD就行，这样快

Sub net()
Dim xml6 As Object
Set xml6 = CreateObject("Microsoft.XMLHTTP")
URL = "http://www.163.com"
xml6.Open "HEAD", URL, False
xml6.Send
  If xml6.Status = 200 Then
    MsgBox "可以"
  Else
    MsgBox "不可以"
  End If
End Sub

haoyf

这个真的能用，谢谢

seeyoutime

liucqa 发表于 2012-8-19 12:16
取HEAD就行，这样快

Sub net()

ok ok                  

sunny_8848

不错的功能，多谢

莫悠悠

判断网络连接还有这么多方法，谢谢分享

引子玄

归纳得很好

莫悠悠

liucqa 发表于 2012-8-19 12:16
取HEAD就行，这样快

Sub net()

拔掉网线，测试2楼的方法没反应

引子玄

莫悠悠 发表于 2012-12-11 10:27
拔掉网线，测试2楼的方法没反应

学习了.无线网卡

kangatang

莫悠悠 发表于 2012-12-11 10:27
拔掉网线，测试2楼的方法没反应

加个
On Error Resume Next