方法一:
Option ExplicitPrivate Enum EIGCInternetConnectionState
        INTERNET_CONNECTION_MODEM = &H1&
        INTERNET_CONNECTION_LAN = &H2&
        INTERNET_CONNECTION_PROXY = &H4&
        INTERNET_RAS_INSTALLED = &H10&
        INTERNET_CONNECTION_OFFLINE = &H20&
        INTERNET_CONNECTION_CONFIGURED = &H40&
End EnumPrivate Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _
        Alias "InternetGetConnectedStateExA" _
        (ByRef lpdwFlags As Long, _
        ByVal lpszConnectionName As String, _
        ByVal dwNameLen As Long, _
        ByVal dwReserved As Long _
        ) As Long
        
Private Const WSADescription_Len = 256
Private Const WS_VERSION_REQD = &H101
Private Const WSASYS_Status_Len = 128
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1Private Type WSADATA
  wversion As Integer
  wHighVersion As Integer
  szDescription(0 To WSADescription_Len) As Byte
  szSystemStatus(0 To WSASYS_Status_Len) As Byte
  iMaxSockets As Integer
  iMaxUdpDg As Integer
  lpszVendorInfo As Long
End TypeFunction lobyte(ByVal wParam As Integer)
  lobyte = wParam And &HFF&
End FunctionFunction hibyte(ByVal wParam As Integer)
  hibyte = wParam \ &H100 And &HFF&
End FunctionSub SocketsInitialize()
  
  Dim WSAD As WSADATA
  Dim iReturn As Integer
  Dim sLowByte As String, sHighByte As String, sMsg As String
  
  iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
  
  If iReturn <> 0 Then
      MsgBox "Winsock.dll is not responding."
      End
  End If
  
  If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
      sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
      sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
      sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
      sMsg = sMsg & " is not supported by winsock.dll "
      MsgBox sMsg
      End
  End If
  
  If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
      sMsg = "This application requires a minimum of "
      sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
      MsgBox sMsg
      End
  End If
  
End SubPrivate Function InternetConnected(Optional ByRef eConnectionInfo _
    As EIGCInternetConnectionState, Optional ByRef _
    sConnectionName As String) As Boolean
    
    Dim dwFlags As Long
    Dim sNameBuf As String
    Dim lR As Long
    Dim iPos As Long
    
    sNameBuf = String$(513, 0)
    lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
    eConnectionInfo = dwFlags
    iPos = InStr(sNameBuf, vbNullChar)
    If iPos > 0 Then
        sConnectionName = Left$(sNameBuf, iPos - 1)
    ElseIf Not sNameBuf = String$(513, 0) Then
        sConnectionName = sNameBuf
    End If
    InternetConnected = (lR = 1)
End FunctionPrivate Sub Command1_Click()
Dim Inet As Boolean
Dim eR As EIGCInternetConnectionState
Dim sName As String
      Inet = InternetConnected(eR, sName)  SocketsInitialize
    If Inet = False Then
        MsgBox "没有连接到Internet。"
        Exit Sub
    ElseIf Inet = True Then
        MsgBox "已经连接到Internet。"
        Exit Sub
    End IfEnd Sub方法二:
Option ExplicitPrivate Const REG_DWORD = 4                      ' 32-bit number
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long        ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongFunction CheckNet() As Boolean
Dim lData As Long, lType As Long, lSize As Long
Dim hKey As Long, Qry As Long
    Qry = RegOpenKey(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\RemoteAccess", hKey)
    If Qry <> 0 Then
          MsgBox "Can't Open Statistics Key"
          End
    End If
    lType = REG_DWORD
    lSize = 4
    Qry = RegQueryValueEx(hKey, "Remote Connection", 0, lType, lData, lSize)
If lData = 1 Then
CheckNet = True
Else
CheckNet = False
End If
    Qry = RegCloseKey(hKey)
End FunctionPrivate Sub Command1_Click()
If CheckNet = True Then
  MsgBox "已经连接到因特网!"
Else
  MsgBox "没有连接到因特网!"
End If
End Sub
还可以监测IP,如果时127.0.0.1则没有!