VBA Getting control of open internet window with specific URL

[Sense]

Hi All,
I decided to drop a question here since I could not find a solution after looking for hours.
I am working on a DB which gets information from a web page. The script starts with trying to use an open instance of internet explorer.


This part doesn't work. I have used the script successful in excel, but run into an error when running It with Access:
"ActiveX component can't create object" (Error 429)
The part of code is as following:

Sub TestY()
Dim GetIEatURL As Object
Dim sMatch As String
Dim ie As Object
Dim oShApp As Object
Dim oWin As Object
sMatch = "https://www.google.com"
On Error Resume Next
Set oShApp = CreateObject("Shell.Application")
For Each oWin In oShApp.Windows
    If TypeName(oWin.Document) = "HTMLDocument" Then
        Set ie = oWin
        If LCase(ie.LocationURL) Like LCase(sMatch) Then
            Exit For
        End If
    End If
Next
Set oShApp = Nothing
Set oWin = Nothing
Debug.Print ie.LocationURL
    
End Sub

The error happens with the line

Set oShApp = CreateObject("Shell.Application")

The References I use are:
Visual Basic For Applications
Microsoft Access 15.0 Object Library
Microsoft Excel 15.0 Object Library
OLE automation
Microsoft Ofice 15.0 Object Library
Microsoft Internet controls
Microsoft Shell Controls and automation
Microsoft HTML object library
ExcelPlugInSHell 1.0 Type library
Any help will be appreciated!

[ranman256]

did you try putting the Internet browser control into a form, then control that?

[isladogs]

If the object already exists, you should use GetObject instead of CreateObject.

Do you really use all of those references?

[Sense]

Thanks for the replies,
I have used these before so I kept them on. Do you think it might cause the error?
I'll try GetObject.

@Ranman256 Is navigating html via the form the same? ( like ie1.document.getelementbyid("idc1").children(0).va lue etc.)

[June7]

I ran your code while IE browser already open - no error, works just fine. Just not sure it does what you want. What do you want to accomplish?

I don't have the last 2 libraries selected. Having unneeded libraries selected should not cause an issue.

[Sense]

Thanks for your response,

I want to retrieve realtime data to my database when pressing a button. to save time I want to keep an instance of ie opened in the background and use that to get the data. If I have to open a new browser every time, I also have to login, navigate to the page and close the explorer each time.

For testing I extracted this bit of code. it should print the URL in the immediate window when www.google.com is open

[Sense]

Thanks for your response,

I want to retrieve realtime data to my database when pressing a button. to save time I want to keep an instance of ie opened in the background and use that to get the data. If I have to open a new browser every time, I also have to login, navigate to the page and close the explorer each time.

For testing I extracted this bit of code. it should print the URL in the immediate window when www.google.com is open..

So the original function is like this:

Function GetIEatURL(sMatch As String) As Object
Dim ie As Object, oShApp As Object, oWin As Object
Set oShApp = CreateObject("Shell.Application")
For Each oWin In oShApp.Windows
    If TypeName(oWin.Document) = "HTMLDocument" Then
        Set ie = oWin
        If LCase(ie.LocationURL) Like LCase(sMatch) Then
            Set GetIEatURL = ie
            Exit For
        End If
    End If
Next
Set oShApp = Nothing
Set oWin = Nothing
End Function

Sub testx ()
Dim sMatch as string
Dim ie1 as internetexplorermedium

sMatch = "www.google.com"
    On Error Resume Next
        Set ie1 = GetIEatURL(sMatch & "*")
End sub

after this bit I can continue with ie1 as internetexplorermedium

[Sense]

Unfortunately GetObject doesn't do it for me.

[June7]

Code in first post prints a URL even when google.com is not open.

Now trying the new code. No errors but also does not ever match the URL until I modified to include wildcard before the match string: Set ie1 = GetIEatURL("*" & sMatch & "*")

I cannot replicate error using Access2010.

[isladogs]

Unfortunately GetObject doesn't do it for me.

How did you use it? What happened? Error? Nothing?
Suggest you show the code you used

[Sense]

I used the code like this:

 
Function GetIEatURL(sMatch As String) As Object
Dim ie As Object, oShApp As Object, oWin As Object
Set oShApp = GetObject(, "Shell.Application")
For Each oWin In oShApp.Windows
    If TypeName(oWin.Document) = "HTMLDocument" Then
        Set ie = oWin
        If LCase(ie.LocationURL) Like LCase(sMatch) Then
            Set GetIEatURL = ie
            Exit For
        End If
    End If
Next
Set oShApp = Nothing
Set oWin = Nothing
End Function

Sub SUReport() '                           |
'                                          |
'===========================================
Dim SuReports As DAO.Recordset
Set SuReports = CurrentDb.OpenRecordset("SELECT * From SuReports")
Dim i As Integer
Dim r As Integer
Dim Loadtime As Variant
Dim CurReport As String
Dim objCollection As Object
Dim objElement As Object
While SuReports("Execute") = True
Debug.Print SuReports("ReportID")
DetermineBrowser1:
'================================================================================
        Dim ie1 As InternetExplorerMedium
        sMatch = "https://www.google.com/"
    On Error Resume Next
        Set ie1 = GetIEatURL("*" & sMatch & "*")

Debug.print ie1.locationURL

End sub

With the "on error resume next" line disabled, At the "getobject" line it gives the error: Active x component can't create object
Else I get no error ofcourse. It does nothing then.

[Sense]

I have also tried createobject with double wildcard but unfortunately no success. Same code as above but Createobject instead.

Thanks both for the help!

[isladogs]

The method I use first checks whether the application is running.
If it is, then GetObject is used. If not running, then CreateObject is used.

Here are two methods of using the idea taken from one of my apps
They are for Excel & Outlook but will work for any application that you know how to reference

Method 1 - requires error handling

Function MyFunctionName()

On Error Goto Err_Handler

...other unrelated code here if needed

  'Start Excel
    On Error Resume Next

    Dim oExcel As Object
    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel
 
    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("Excel.Application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If
    
    On Error GoTo Error_Handler

...more unrelated code here

  Set oExcel = Nothing

Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & " in MyFunctionName routine: " & Err.Description
Resume Exit_Handler
Exit Function

Method 2 - uses external function

Function MyFunctionName()

On Error Goto Err_Handler

...other unrelated code here if needed

  Dim objOutlook As Object
 ' Create the Outlook session.
  If IsAppRunning("Outlook.Application") = True Then
    'Use existing instance of Outlook
    Set objOutlook = CreateObject("Outlook.Application")
  Else
   'Could not get instance of Outlook, so create a new one
        Path = GetAppExePath("outlook.exe")    'determine outlook's installation path
        Shell (Path), vbMinimizedFocus   'start outlook
        Do While Not IsAppRunning("Outlook.Application")
            DoEvents
        Loop
        Set objOutlook = GetObject(, "Outlook.Application") 'Bind to new instance of Outlook
  End If

...more unrelated code here if needed

  Set objOutlook =  Nothing

Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & " in MyFunctionName routine: " & Err.Description
Resume Exit_Handler
Exit Function

For method 2, place this function in a standard module

Function IsAppRunning(sApp As String) As Boolean    On Error GoTo Error_Handler
    
    Dim oApp As Object
 
    Set oApp = GetObject(, sApp)
    IsAppRunning = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set oApp = Nothing
    Exit Function
 
Error_Handler:
    Resume Error_Handler_Exit
End Function

Hopefully you can see how to incorporate one of these methods into your interestingly named GetIEatURL function
If not, get back to me

Hope that helps

[Sense]

Thanks!
I'm going to insert the code now and let you know if it works.
I noticed you put all code in Functions. I am used to using subs in excel vba. what's the benefits of using a function instead of a sub?

[June7]

A function is required if need to return a value to calling procedure. Also, queries and Access controls can see functions but not subs.