LABEL ..

Option Explicit
'Código pra pegar o capition de uma página de internet

[c]Private Sub Command1_Click()
Dim IE As Object
Dim Sitev As String
Dim ObjShell As Object
Dim SWs As Object

Set IE = CreateObject("internetexplorer.application")
Set ObjShell = CreateObject("Shell.Application")
Set SWs = ObjShell.Windows

List1.Clear

For Each IE In SWs
    Sitev = IE.LocationURL
    If Left(UCase(Sitev), 4) = "HTTP" Or Left(UCase(Sitev), 3) = "WWW" Or Left(UCase(Sitev), 3) = "FTP" Or Left(UCase(Sitev), 3) = "NEWS" Then
       List1.AddItem IE.LocationName
    End If
Next

End Sub

Private Sub Command2_Click()
'PEGAR ENDERECO DE UMA JANELA DO INTERNET EXPLORER

'Adaptado de um projeto em http://gaminghelp.pics-world.net/mystic/kochelp.html por rafabugre@hotmail.com
'ATENÇÂO: Referenciar Microsoft Internet Controls

'Lista todas as janelas abertas pelo internet explorer
'(Inclui windows explorer, já que são a mesma coisa)
'collection of all open explorer windows

Dim SWs As New SHDocVw.ShellWindows
'pointer to one explorer window
Dim IE As SHDocVw.InternetExplorer

    List2.Clear
'Listar janelas
For Each IE In SWs
    If Mid(IE.LocationURL, 1, 11) <> "file:///C:/" Then  'p/ excluir o Win Explore
        List2.AddItem IE.LocationURL
    End If
Next
End Sub

Private Sub Form_Load()
'Verificando se o Computador está Conectado à Internet
'P/ chamar a função, no evento que você quizer:
  If ActiveConnection Then
    MsgBox "Seu computador está conectado a Internet"
  Else
    MsgBox "Não há conexão com a Internet"
  End If
  'NÃO ESTÁ FUNCIONANDO QUANDO SE TEM
  'UMA CONEXÃO VIA REDE (LAN)
End Sub

Option Explicit

'Verificando se o Computador está Conectado à Internet
'No módulo:

Private Const ERROR_SUCCESS = 0&
Private Const APINULL = 0&
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private ReturnCode As Long

Private Declare Function RegCloseKey Lib _
        "advapi32.dll" (ByVal hKey As Long) _
        As Long
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

[c]Public Function ActiveConnection() As Boolean
  Dim hKey As Long
  Dim lpSubKey As String
  Dim phkResult As Long
  Dim lpValueName As String
  Dim lpReserved As Long
  Dim lpType As Long
  Dim lpData As Long
  Dim lpcbData As Long
  ActiveConnection = False
  lpSubKey = "System\CurrentControlSet\" & _
             "Services\RemoteAccess"

  ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, _
               lpSubKey, phkResult)

  If ReturnCode = ERROR_SUCCESS Then
    hKey = phkResult
    lpValueName = "Remote Connection"
    lpReserved = APINULL
    lpType = APINULL
    lpData = APINULL
    lpcbData = APINULL

    ReturnCode = RegQueryValueEx(hKey, _
                 lpValueName, lpReserved, _
                 lpType, ByVal lpData, lpcbData)

    lpcbData = Len(lpData)

    ReturnCode = RegQueryValueEx(hKey, _
                 lpValueName, lpReserved, _
                 lpType, lpData, lpcbData)

    If ReturnCode = ERROR_SUCCESS Then
      If lpData = 0 Then
        ActiveConnection = False
      Else
        ActiveConnection = True
      End If
    End If
  RegCloseKey (hKey)
  End If
End Function