VBA Macro For Already Open IE Window

[RL101]

Hi all,

I'm looking to create a VBA macro which will be ran from Excel (2003 or 2010) & which works with Internet Explorer. I have added 'Microsoft Internet Controls' to VBA References, and have looked at plenty of VBA code on the forum which opens & then navigates to specific websites.

However, what I need is for this macro to affect an already open IE window.

Does anyone have an idea of the syntax / command to have excel "select" a specific IE window already open?

Many thanks!

 

[Pegaso]

ZVI,

It does work! I just quickly tested but I was able to see the code in the immediate window, I'll incorporate it to the rest of the code and do a full test.

Something else, how can I close each new instance of IE at the end of the procedure? (I need to run this over a large number of websites, and it doesn't make any sense to leave them open once the program is done with each one of them.

I tried IE.Close, IE.Quit but no success, I checked the subject and I couldn't find something useful.

Warmest regards ZVI!

Pegaso

 

[ZVI]

Thanks for the fast testing and the feedback!
To quit created instance of IE use the flag (boolean) variable and do IE.Quit before Set IE = Nothing , like this:

Function GetBodyInnerHTML(Cell As Range, Optional WaitSeconds As Long = 20) As String
  ' ZVI:2015-04-21 http://www.mrexcel.com/forum/excel-questions/553580-visual-basic-applications-macro-already-open-ie-window-2.html
  ' Arguments:
  '   Cell        - the cell with hyperlink to the web page:
  '   WaitSeconds - (optional) timeout in seconds for IE navigation
  ' Returns InnerHTML of the web page referenced in the hyperlink of the Cell
  ' (already open IE window is used if exists)
  Dim IE As Object
  Dim t As Single
  Dim Url As String
  Dim IsNew As Boolean
  For Each IE In CreateObject("Shell.Application").Windows
    If IE.Name = "Windows Internet Explorer" Then
      ' IE window found
      'Debug.Print "IE is already open" ' <-- For testing
      Exit For
    End If
  Next
  If IE Is Nothing Then
    ' Create new IE object
    IsNew = True
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Silent = True
    IE.Visible = True     ' <-- Comment it to skip blinking
    'Debug.Print "New IE" ' <-- For testing
  End If
  ' Get url from the cell
  If Cell.Hyperlinks.Count > 0 Then
    ' Hyperlink object is present in the cell
    Url = Cell.Hyperlinks(1).Address
  Else
    ' May be hyperlink is in the cell's value (text)
    Url = Cell.Value
  End If
  ' Do navigation
  IE.Navigate Url
  ' Charge the timeout
  t = Timer + WaitSeconds
  ' Wait for "IE is ready" state
  While IE.ReadyState <> 4 And Timer < t: DoEvents: Wend
  ' Wait for "IE.Document is completely downloaded" state
  If Timer < t Then
    While IE.Document Is Nothing And Timer < t: DoEvents: Wend
  Else
    Err.Raise vbObjectError + 513, , "Timeout happens: " & WaitSeconds & " seconds"
  End If
  ' Return Body's innerHTML
  GetBodyInnerHTML = IE.Document.Body.innerHTML
  ' Quit IE
  If IsNew Then IE.Quit
  ' Clear the memory of object variable
  Set IE = Nothing
End Function

 

[mynameissaturn]

Hi ZVI,

May you help me as well? I hope I am on the right thread.

This time I am using Firefox (with installed Selenium) with already opened Website titled "All Incoming Work Requests". I also have Activity ID's on excel column A and Employee numbers on excel column B.

Column A Column B
1-14VOW19 ACAB3024
1-14VPK3E ACAB3007
1-14VPJP9 ACAB3008
1-14VR0NX ACATB3017
1-14VP388 ACATB3013


What I want to do is,

1. Click the Query button (button id="s_1_1_21_0_Ctrl") on the website.
(Then wait for the site to be completely loaded. Approx 1-2 seconds to load)
2. Copy the 1st Activity ID on excel Column A.
3. Select the Activity ID field (input id="1_Activity_Id") and paste the Activity ID that was copied.
4. Copy the 1st Employee number on excel Column B.
5. Select the Owner field (input id="1_Owned_By") and paste the Employee number that was copied.
6. Then click on the GO button (button id="s_1_1_20_0_Ctrl") so that the Activity ID will be assigned to the employee.
(Then wait for the site to be completely loaded. Approx 1-2 seconds to load)
7. Again back to step number 1 and loop this process until all the data on column A and column B are done.

This will be use for Dispatching Works automatically. This process consumes so much time and effort on manually assigning more than a hundred of Activity IDs daily.

Hoping to here from you.

Thanks a lot!

 

[Pegaso]

Vladimir,

After a few modifications to handle the enormous amount of files, I was able to download ~100k .pdf files, thanks a lot for your help, I improved my knowledge in the use of excel-vba to control other software as IE in this case.

Now I'm facing a similar challenge, but this time I need to deal with the non-pdf files in my database. The .pdf files are downloaded automatically (I had to change options in Adobe Acrobat to disable the .pdf support to IE), the rest of the files, I found no way to force IE to download them, (.txt, .doc, .jpg, .bmp, etc..). I found an alternative using HTML5 (see here), I was able to create .html files that when open, only display a link, when the link is clicked, the file starts to download. This is an improvement but since I'm not familiar with HTML5 I need help in making the code to do the following:

1. Automatically click the link, so it will trigger the downloading of the file
2. If possible, give a name to the file to download file, it is simply saved as ParseFile.htm, since I need to do this several thousand times, I would like the file to have a meaningful name.

The following code creates the .html file with the required link and opens the file later on, but I still need to click the link and if possible give a meaningful name to the file, preferably before downloading it.

[/FONT][/COLOR]#If VBA7 Then    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If


Sub CreateHTML()


Sheets("Summary-1").Activate


VaultMin = Cells(2, 2)
VaultMax = Cells(3, 2)
FilePath = Cells(2, 5)


TextA = """"
Text1 = "<a href="
Text2 = "http://xx.yyyzzz.com/new_zzzggghhhASP/fileParse.php?attachID="
Text4 = "&fileID="
Text6 = " download="
Text7 = "FileName"
Text8 = ">File abc</a>"


For t = VaultMin To VaultMax
    Text = ""
    If Cells(t, 5) <> ".pdf" Then
    
        Text3 = Cells(t, 6)
        Text5 = Cells(t, 7)
        Filename = "HTML-" & Text3 & "-" & Text5 & ".html"
        MyFile = FilePath & Filename
        Text = Text1 & TextA & Text2 & Text3 & Text4 & Text5 & TextA & Text6 & TextA & Text7 & TextA & Text8
        
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.CreateTextFile(MyFile, True)
    
        f.Write Chr(9) & Text 'strMyPage
        f.Close
        
        Call OpenAnyFile(MyFile)
        
    Else: End If


Next t


End Sub


Function OpenAnyFile(FileToOpen As String)
     
    Call ShellExecute(0, "Open", FileToOpen & vbNullString, _
    vbNullString, vbNullString, 1)
     
End Function


[COLOR=#000000][FONT=verdana]

By the way, this HTML5 script doesn't work in IE, just in Chrome, so I have the additional problem of controlling Chrome with VBA (with IE is well documented, but I couldn't find the same level of documentation for Chrome)

Apologies if this is not placed exactly in the right place, but since the tread started here I prefer to keep the updates in the same place

Warmest regards and thanks in advance Vladimir for all your help!

Pegaso

 

[tintino]

Vladimir,

After a few modifications to handle the enormous amount of files, I was able to download ~100k .pdf files, thanks a lot for your help, I improved my knowledge in the use of excel-vba to control other software as IE in this case.

Now I'm facing a similar challenge, but this time I need to deal with the non-pdf files in my database. The .pdf files are downloaded automatically (I had to change options in Adobe Acrobat to disable the .pdf support to IE), the rest of the files, I found no way to force IE to download them, (.txt, .doc, .jpg, .bmp, etc..). I found an alternative using HTML5 (see here), I was able to create .html files that when open, only display a link, when the link is clicked, the file starts to download. This is an improvement but since I'm not familiar with HTML5 I need help in making the code to do the following:

1. Automatically click the link, so it will trigger the downloading of the file
2. If possible, give a name to the file to download file, it is simply saved as ParseFile.htm, since I need to do this several thousand times, I would like the file to have a meaningful name.

The following code creates the .html file with the required link and opens the file later on, but I still need to click the link and if possible give a meaningful name to the file, preferably before downloading it.

#If VBA7 Then    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If


Sub CreateHTML()


Sheets("Summary-1").Activate


VaultMin = Cells(2, 2)
VaultMax = Cells(3, 2)
FilePath = Cells(2, 5)


TextA = """"
Text1 = "<a href="<br /> Text2 = " http:="" xx.yyyzzz.com="" new_zzzggghhhasp="" fileparse.php?attachid="
Text4 = " &fileid="
Text6 = " download="
Text7 = " filename"
 Text8 = ">File abc"


For t = VaultMin To VaultMax
    Text = ""
    If Cells(t, 5) <> ".pdf" Then
    
        Text3 = Cells(t, 6)
        Text5 = Cells(t, 7)
        Filename = "HTML-" & Text3 & "-" & Text5 & ".html"
        MyFile = FilePath & Filename
        Text = Text1 & TextA & Text2 & Text3 & Text4 & Text5 & TextA & Text6 & TextA & Text7 & TextA & Text8
        
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.CreateTextFile(MyFile, True)
    
        f.Write Chr(9) & Text 'strMyPage
        f.Close
        
        Call OpenAnyFile(MyFile)
        
    Else: End If


Next t


End Sub


Function OpenAnyFile(FileToOpen As String)
     
    Call ShellExecute(0, "Open", FileToOpen & vbNullString, _
    vbNullString, vbNullString, 1)
     
End Function

By the way, this HTML5 script doesn't work in IE, just in Chrome, so I have the additional problem of controlling Chrome with VBA (with IE is well documented, but I couldn't find the same level of documentation for Chrome)

Apologies if this is not placed exactly in the right place, but since the tread started here I prefer to keep the updates in the same place

Warmest regards and thanks in advance Vladimir for all your help!

Pegaso

@Pegaso, this is off-topic, but there are many ways to download a file (google VBA download file)

For example you can use XMLHTTP object

This function saves the file found at url, to the path passed in parameter spath (spath is a complete path with file name)
It returns false, if it failed... and it considers any http status code other than 200, as a fail.

Function http_FetchFile(sURL As String, sPath) As Boolean

 Dim oXHTTP As Object
 Dim oStream As Object
Dim success As Boolean


    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    Set oStream = CreateObject("ADODB.Stream")
    Application.StatusBar = "Fetching " & sURL & " as " & sPath
    oXHTTP.Open "GET", sURL, False
    oXHTTP.send
    Debug.Print oXHTTP.Status
    With oStream
        .Type = 1 'adTypeBinary
        .Open
        .Write oXHTTP.responseBody
        If oXHTTP.Status = 200 Then
            .SaveToFile sPath, 2 'adSaveCreateOverWrite
            success = True
        Else
            success = False
        End If
        .Close
    End With
    Set oXHTTP = Nothing
    Set oStream = Nothing
    Application.StatusBar = False

http_FetchFile = success


End Function

 

[Kurt]

Hello ZVI,

Lot's of great examples here. I found Nories old thread and your old thread while doing a search.

Can you take a look at this post I continued please?

Thanks,

Kurt

 

[Wolfee200]

I just wanted to say Thank you for the good explanations in this thread. I am having to do a work around as work install O365 for email and now my IE scripts for Excel are failing. This has helped me re-link to IE.

 

[Kurt]

I just wanted to say Thank you for the good explanations in this thread. I am having to do a work around as work install O365 for email and now my IE scripts for Excel are failing. This has helped me re-link to IE.

I am glad this thread was able to help you out.

Have you done anything similar in Excel using VBA and if so do you mind sharing your code?

Have a great rest of the week!

 

[Kurt]

Well, then please copy all the below updated code into VBA module and run Test1 subroutine.
If it works then try new GetBodyInnerHTML with your workbook.
If it does not work then what will happen if you click hyperlink of F2 cell in testing sheet which is created by Test1 subroutine?

Sub Test1()
  Dim strMyPage As String
  ' Create new worbook for testing
  With Workbooks.Add
    With Sheets(1)
      ' Prepare testing sheet
      .Activate
      .Name = "Summary"
      ' Add hyperlink for the testing
      .Hyperlinks.Add Anchor:=.Range("F2"), _
                      Address:="http://www.mrexcel.com/forum/faq.php", _
                      ScreenTip:="MrExcel Message Board FAQ", _
                      TextToDisplay:="MrExcel FAQ"
    End With
  End With
  ' Put Body's innerHTML to the strMyPage variable
  strMyPage = GetBodyInnerHTML(Range("F2"))
  ' Print strMyPage into Immediate window of VBE
  Debug.Print strMyPage
End Sub
 
 
Function GetBodyInnerHTML(Cell As Range, Optional WaitSeconds As Long = 10) As String
  ' ZVI:2015-04-20 http://www.mrexcel.com/forum/excel-questions/553580-visual-basic-applications-macro-already-open-ie-window-2.html
  ' Arguments:
  '   Cell        - the cell with hyperlink to the web page
  '   WaitSeconds - (optional) timeout in seconds for IE navigation
  ' Returns InnerHTML of the web page referenced in the hyperlink of the Cell
  ' (already open IE window is used if exists)
  Dim IE As Object, w As Object
  Dim t As Single
  Dim Url As String
  For Each w In CreateObject("Shell.Application").Windows
    If w.Name = "Windows Internet Explorer" Then
      ' Get IE
      'Debug.Print "IE is already open" ' <-- for testing
      Set IE = w
      Exit For
    End If
  Next
  If IE Is Nothing Then
    ' Create IE
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Silent = True
    IE.Visible = True
    'Debug.Print "New IE" ' <-- for testing
  End If
  ' Get url from the cell
  If Cell.Hyperlinks.Count > 0 Then
    ' Hyperlink object is present in the cell
    Url = Cell.Hyperlinks(1).Address
  Else
    ' May be hyperlink is in the cell's value (text)
    Url = Cell.Value
  End If
  ' Do navigation
  IE.Navigate Url
  ' Charge the timeout
  t = Timer + WaitSeconds
  ' Wait for "IE is ready" state
  While IE.ReadyState <> 4 And Timer < t: DoEvents: Wend
  ' Wait for "IE.Document is completely downloaded" state
  If Timer < t Then
    While IE.Document Is Nothing And Timer < t: DoEvents: Wend
  Else
    Err.Raise vbObjectError + 513, , "Timeout happens: " & WaitSeconds & " seconds"
  End If
  ' Return Body's innerHTML
  GetBodyInnerHTML = IE.Document.Body.innerHTML
  ' Clean the memory of object variables
  Set w = Nothing
  Set IE = Nothing
End Function

Hello ZVI,

I am revisiting my old post and trying your code.

I have to use IE 8 per companies guidelines.

I get an error on this line of your code:

    Err.Raise vbObjectError + 513, , "Timeout happens: " & WaitSeconds & " seconds"

The error message states: Timeout happens 10 seconds.

Do I need to increase the time for the timeout?

 

[dhustwayte]

Hi Eric,
Welcome to MrExcel !
Function GetIeByTitle finds IE window by window title and returns IE object.
See example of the usage in Test1 subroutine.

' ZVI:2013-03-19 Get IE object of already open window by its title
' Arguments:
'   Title     -  title of the searchied IE window
'   [IsLike]  -  False/True = exact/partial searching, default is False
'   [IsFocus] -  False/True = don't_activate/activate IE window, default is False
Function GetIeByTitle(Title, Optional IsLike As Boolean, Optional IsFocus As Boolean) As Object
  Dim w As Object
  For Each w In CreateObject("Shell.Application").Windows
    With w
      If .Name = "Windows Internet Explorer" Then
        If IsLike Then
          If InStr(1, .LocationName & " - " & .Name, Title, vbTextCompare) > 0 Then
            ' Partial title of window is found - activate IE window
            If IsFocus Then
              w.Visible = False
              w.Visible = True
            End If
            Set GetIeByTitle = w
            Exit For
          End If
        Else
          If StrComp(.LocationName & " - " & .Name, Title) = 0 Then
            ' Title of window is found - activate IE window
            If IsFocus Then
              w.Visible = False
              w.Visible = True
            End If
            Set GetIeByTitle = w
            Exit For
          End If
        End If
      End If
    End With
  Next
  Set w = Nothing
End Function
 
Sub Test1()
  Dim IE As Object
  Set IE = GetIeByTitle("VBA Macro For Already Open IE Window", True, True)
  IE.Navigate "http://www.mrexcel.com/forum/excel-questions/553580-visual-basic-applications-macro-already-open-ie-window-2.html#post3423470"
End Sub

Regards

Hi,

I have been trying to get this to work for some time now but I have a few issues with running.

For some reason the w.visible = true does not activate the window and all the other codes on this thread simply debug.print the site title and not select it.

Am I missing something simple here? Ultimately I just want to activate a window and copy its contents to a worksheet.

Thanks in advance