IF(A73X) {TRUE;}

Declare API

Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef dwflags As Long, _
  ByVal dwReserved As Long) As Long
Private Const CONNECT_LAN As Long = &H2
  Private Const CONNECT_MODEM As Long = &H1
  Private Const CONNECT_PROXY As Long = &H4
  Private Const CONNECT_OFFLINE As Long = &H20
  Private Const CONNECT_CONFIGURED As Long = &H40

Function:

Public Function IsWebConnected(Optional ByRef ConnType As String) As Boolean
      Dim dwflags As Long
      Dim WebTest As Boolean
      ConnType = ""
      WebTest = InternetGetConnectedState(dwflags, 0&)
      Select Case WebTest
          Case dwflags And CONNECT_LAN: ConnType = "LAN"
          Case dwflags And CONNECT_MODEM: ConnType = "Modem"
          Case dwflags And CONNECT_PROXY: ConnType = "Proxy"
          Case dwflags And CONNECT_OFFLINE: ConnType = "Offline"
          Case dwflags And CONNECT_CONFIGURED: ConnType = "Configured"
          Case dwflags And CONNECT_RAS: ConnType = "Remote"
      End Select
      IsWebConnected = WebTest
  End Function
  Private Sub Command1_Click()
      Dim msg As String
      If IsWebConnected(msg) Then
          msg = "You are connected to the Internet via: " & msg
      Else
          msg = "You are not connected to the Internet."
      End If
      
      MsgBox msg, vbOKOnly, "Internet Connection Status"
  End Sub

Version 2

Public Function NetConnectStatus() As Boolean
    On Error GoTo err_DoWebRequest
    Dim strurl As String
    Dim DoWebRequest As String
    strurl = "https://www.google.co.in/"
    
    Dim objXML As Object
    Set objXML = CreateObject("Microsoft.XMLHTTP")
    objXML.Open "GET", strurl, False
    objXML.Send
    If (objXML.Status = 404) Then
        DoWebRequest = "404 Error"
        DoWebRequest = objXML.responseText
    Else
        NetConnectStatus = True
    End If
    Set objXML = Nothing
    Exit Function
err_DoWebRequest:
    NetConnectStatus = False
End Function