Private Const FLAG_ICC_FORCE_CONNECTION As Long = &H1
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
 

    If InternetCheckConnection("http://www.google.com/", FLAG_ICC_FORCE_CONNECTION, 0&) = 0 Then
        MsgBox "Нет интернета!"
    Else
        MsgBox "Есть связь."
    End If

Public Function conectya() As Boolean
    Dim URL1 As String
    URL1$ = "http://www.ya.ru"
    Dim oHttp1 As WinHttpRequest
    On Error Resume Next: Err.Clear
    Set oHttp1 = New WinHttpRequest
    On Error GoTo 1
     oHttp1.Open "GET", URL1$, True: DoEvents
     oHttp1.Send: DoEvents
     sss = oHttp1.ResponseText
    Set oHttp1 = Nothing
    conectya = True
    Exit Function
1:
    Set oHttp1 = Nothing
    conectya = False
End Function

Public Function conectya() As Boolean
    Dim URL1 As String
    URL1$ = "http://www.ya.ru"
    Dim oHttp1 As WinHttpRequest
'    On Error Resume Next: Err.Clear
    Set oHttp1 = New WinHttpRequest
    On Error GoTo 1
     oHttp1.Open "GET", URL1$, True: DoEvents
     oHttp1.Send: DoEvents
     SleepVB (2)
     Sss1 = oHttp1.ResponseText
    Set oHttp1 = Nothing
    conectya = True
    Exit Function
1:
    Set oHttp1 = Nothing
    conectya = False
End Function
Public Sub SleepVB(Seconds)
  ' ожидание Seconds секунд
  Dim Start
  Start = Timer   ' текущее время в секундах
  Do While Timer < Start + Seconds
    ' обеспечивает параллельное выполнение других процессов
    DoEvents ' обрабатываем
  Loop
End Sub

...
    Dim oHttp1 As Object
    Set oHttp1 = CreateObject("WinHttp.WinHttpRequest.5.1")
...