Ho un form con un CommandButton e un modulo.
Per aprire una pagine di IE:
1. Inserisci nel modulo:
codice:
Public Const ERROR_NONE = 0
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const KEY_ALL_ACCESS = &H3F
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegQueryValueExNULL Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As Long, lpcbData As Long) _
As Long
Public Declare Function RegQueryValueExString Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As String, lpcbData As Long) _
As Long
Public Declare Function RegQueryValueExLong Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Long, lpcbData As Long) As Long
Public Function QueryValue(RootKey As Long, sKeyName As String, _
sValueName As String) As Variant
On Error GoTo Errore
Dim mioRis As Long 'result of the API functions
Dim mioKey As Long 'handle of opened key
Dim mioValore As Variant 'setting of queried value
mioRis = RegOpenKeyEx(RootKey, sKeyName, 0, KEY_ALL_ACCESS, _
mioKey)
mioRis = QueryValueEx(mioKey, sValueName, mioValore)
Select Case mioValore
Case "IExplore"
QueryValue = "InternetExplorer"
Case "NSShell"
QueryValue = "Netscape"
Case Else
QueryValue = vValue
End Select
Exit Function
Errore:
MsgBox "Errore n. " & Err.Number & ": " & Err.Description
End Function
Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName _
As String, vValue As Variant) As Long
On Error GoTo Errore
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, _
0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, _
0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
lrc = -1
End Select
QueryValueEx = lrc
Exit Function
Errore:
MsgBox "Errore n. " & Err.Number & ": " & Err.Description
End Function
1. Inserisci nell'evento click del commandbutton il richiamo della sub che apre Internet Explorer:
codice:
Private Sub CommandButton_Click()
ApriSito
End Sub
Sub ApriSito()
On Error GoTo Errore
Dim mioIndirizzo As String, mioBrowser As String
mioIndirizzo = "www.google.it"
mioBrowser = CStr(QueryValue HKEY_CLASSES_ROOT, _
"http\shell\open\ddeexec\Application", ""))
Dim miaPagWeb As Object
Set miaPagWeb = CreateObject(mioBrowser & ".Application")
miaPagWeb.Visible = True
miaPagWeb.Navigate (mioIndirizzo)
Exit Sub
Errore:
MsgBox "Errore n. " & Err.Number & ": " & Err.Description
End Sub