vba to take a screen dump of an IE window already open

C

cjcass

Well-known Member
Joined
Oct 27, 2011
Messages
679
Office Version
  1. 2016
Platform
  1. Windows
Hi,
I'm looking for some code that will take a screen dump of an IE window that is already open and copy it to the clipboard. So, the code mimics me moving from Excel to the IE window (that is already open and maximised), doing a printscreen/copying the whole page, and then pasting it into the worksheet as a picture. It would be good if the code could reference the last IE window opened, if not possible then navigate to a specific opened URL, eg. http://www.google.com
Any help much appreciated.
 
Last edited:
Sort by date Sort by votes
Jaafar Tribak said:
Hi John_w,

True.. GetObject won't work with IE because it doesn't regiter itsef in the ROT... Your soultion works well to get a com pointer to the existing IE instance based on the opened URL.

Would this "Shell" method also work with other browsers like Opera or Firefox ?

Thanks.
Click to expand...
Hi Jaafar,

No, Shell.Windows contains only IE and File Explorer windows.


cjcass said:
Hi, thanks for coming back but this is confusing (probably due to my inexperience).
Click to expand...

Put Jaafar's code in a standard module. Replace:

Code: 
        Set IE = CreateObject("internetexplorer.application")
        IE.Visible = True
        IE.navigate "http://www.Mrexcel.com"
        Do While (IE.Busy Or IE.READYSTATE <> READYSTATE_COMPLETE): DoEvents: Loop
with:

Code: 
    Set IE = Get_IE_Window()
    If IE Is Nothing Then
        MsgBox "Internet Explorer isn't open"
        Exit Sub
    End If
and add the code for the Private Function Get_IE_Window at the bottom of the module, below the End Sub.
 
Upvote 0

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Hi,
Great that works, many thanks.
Just a couple of things if I may:
(a) when the code has run it leaves the IE window displayed, what could I add to the code so it leaves the Excel worksheet displayed after it has run? I tried putting 'ActiveSheet.Select' in at the end but it didn't work.
(b) is it possible to add some code that will zoom the IE window to say 150% before it is copied and pasted?
Thanks again.
 
Upvote 0
You should try Jafaar's code...

You just need to change this part...

Code: 
Set IE = CreateObject("internetexplorer.application")

and use John's function to get the existing window...

Code: 
Set IE = Get_IE_Window("mrexcel")
 
Upvote 0
Hi, yes have done that and it works great, was looking for a couple of additions (as per request above), as follows:
(a) when the code has run it leaves the IE window displayed, what could I add to the code so it leaves the Excel worksheet displayed after it has run? I tried putting 'ActiveSheet.Select' in at the end but it didn't work.
(b) is it possible to add some code that will zoom the IE window to say 150% before it is copied and pasted?
 
Upvote 0
cjcass said:
Hi, yes have done that and it works great, was looking for a couple of additions (as per request above), as follows:
(a) when the code has run it leaves the IE window displayed, what could I add to the code so it leaves the Excel worksheet displayed after it has run? I tried putting 'ActiveSheet.Select' in at the end but it didn't work.
(b) is it possible to add some code that will zoom the IE window to say 150% before it is copied and pasted?
Click to expand...

I think I can answer question (a) as for question (b), I am not familiar with IE object model ... maybe John can answer that for you.

In order to bring the excel window back to the front after the code is ran try this :

(The code below assumes that the existing IE instance has the "http://www.wordle.net/compose" URL loaded) as requested.

In a Standard module :

Code: 
Option Explicit

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
    Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
    Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal format As Long) As Long
    Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
    Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
    Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
    Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function EmptyClipboard Lib "user32" () As Long
    Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal format As Long) As Long
    Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Declare Function GetForegroundWindow Lib "user32" () As Long
    Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
    Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Const READYSTATE_INTERACTIVE = 3
Const READYSTATE_COMPLETE = 4
Const SWP_NOSIZE As Long = &H1&
Const SWP_NOMOVE As Long = &H2&
Const SWP_SHOWWINDOW = &H40
Const SW_SHOWMAXIMIZED = 3
Const HWND_TOPMOST = -1&
Const HWND_NOTOPMOST = -2
Const SRCCOPY = &HCC0020
Const CF_BITMAP = 2
Const SW_SHOW = 5
Const SW_RESTORE = 9

Sub SaveIEToClipboard()
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim hdcScreen As LongPtr, hdc As LongPtr, hbmp As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim hdcScreen As Long, hdc As Long, hbmp As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
        Dim tRect As RECT, IE As Object
        Dim lXLThreadID As Long, lIEThreadID As Long
        
        Set IE = Get_IE_Window()
        If IE Is Nothing Then
            MsgBox "Internet Explorer isn't open"
            Exit Sub
        End If
    
        ShowWindow IE.hwnd, SW_SHOWMAXIMIZED
        Call Sleep(2000)
        Call SetWindowPos(IE.hwnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
        Call GetClientRect(IE.hwnd, tRect)
        hdcScreen = GetDC(0)
        hdc = CreateCompatibleDC(hdcScreen)
        hbmp = CreateCompatibleBitmap(hdcScreen, tRect.Right - tRect.Left, tRect.Bottom - tRect.Top)
        Call SelectObject(hdc, hbmp)
        Call BitBlt(hdc, 0, 0, tRect.Right - tRect.Left, tRect.Bottom - tRect.Top, hdcScreen, tRect.Left, tRect.Top, SRCCOPY)
        Call SetWindowPos(IE.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
        If GetForegroundWindow = IE.hwnd Then
            lIEThreadID = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)
            lXLThreadID = GetWindowThreadProcessId(Application.hwnd, ByVal 0&)
            Call AttachThreadInput(lIEThreadID, lXLThreadID, True)
            Call SetForegroundWindow(Application.hwnd)
            If IsIconic(Application.hwnd) Then
                Call ShowWindow(Application.hwnd, SW_RESTORE)
            Else
                Call ShowWindow(Application.hwnd, SW_SHOW)
            End If
        End If
        
        Call OpenClipboard(0)
        Call EmptyClipboard
        Call SetClipboardData(CF_BITMAP, hbmp)
        Call CloseClipboard
        Call DeleteDC(hdc)
        Call DeleteObject(hbmp)
        Call ReleaseDC(0, hdcScreen)
        If IsClipboardFormatAvailable(CF_BITMAP) <> 0 Then
            ActiveSheet.Paste
        End If
End Sub

Private Function Get_IE_Window(Optional partialURLorName As String) As Object
    'Look for an IE browser window or tab already open at the specified (partial) URL or location name and, if found,
    'return that browser as an InternetExplorer object.  Otherwise return Nothing

    Dim Shell As Object
    Dim IE As Object
    Dim i As Variant 'Must be a Variant to index Shell.Windows.Item() array
    
    Set Shell = CreateObject("Shell.Application")
    i = 0
    Set Get_IE_Window = Nothing
    While i < Shell.Windows.Count And Get_IE_Window Is Nothing
        Set IE = Shell.Windows.Item(i)
        If Not IE Is Nothing Then
            If TypeName(IE) = "IWebBrowser2" And IE.LocationURL <> "" And InStr(IE.LocationURL, "file://") <> 1 Then
                If InStr(IE.LocationURL & IE.LocationName, partialURLorName) > 0 Then
                    Set Get_IE_Window = IE
                End If
            End If
        End If
        i = i + 1
    Wend
End Function
 
Last edited:
Upvote 0
Thanks Jaafar, that works great, now just the zooming (if achievable).
 
Upvote 0
Just a quick web search I managed to find out how easily one can zoom the IE document via the object model:

Try this updated code which will zoom the doc to 1.5 :

Code: 
Option Explicit

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
    Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
    Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal format As Long) As Long
    Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
    Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
    Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
    Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function EmptyClipboard Lib "user32" () As Long
    Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal format As Long) As Long
    Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Declare Function GetForegroundWindow Lib "user32" () As Long
    Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
    Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Const READYSTATE_INTERACTIVE = 3
Const READYSTATE_COMPLETE = 4
Const SWP_NOSIZE As Long = &H1&
Const SWP_NOMOVE As Long = &H2&
Const SWP_SHOWWINDOW = &H40
Const SW_SHOWMAXIMIZED = 3
Const HWND_TOPMOST = -1&
Const HWND_NOTOPMOST = -2
Const SRCCOPY = &HCC0020
Const CF_BITMAP = 2
Const SW_SHOW = 5
Const SW_RESTORE = 9

Sub SaveIEToClipboard()
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim hdcScreen As LongPtr, hdc As LongPtr, hbmp As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim hdcScreen As Long, hdc As Long, hbmp As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
        Dim tRect As RECT, IE As Object
        Dim lXLThreadID As Long, lIEThreadID As Long, sngPrevZoom As Single
        
        Set IE = Get_IE_Window()
        If IE Is Nothing Then
            MsgBox "Internet Explorer isn't open"
            Exit Sub
        End If
    
        ShowWindow IE.hwnd, SW_SHOWMAXIMIZED
        sngPrevZoom = IE.Document.Body.Style.Zoom
        IE.Document.Body.Style.Zoom = 1.5 '<== change zoom as required.
        Call Sleep(2000)
        Call SetWindowPos(IE.hwnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
        Call GetClientRect(IE.hwnd, tRect)
        hdcScreen = GetDC(0)
        hdc = CreateCompatibleDC(hdcScreen)
        hbmp = CreateCompatibleBitmap(hdcScreen, tRect.Right - tRect.Left, tRect.Bottom - tRect.Top)
        Call SelectObject(hdc, hbmp)
        Call BitBlt(hdc, 0, 0, tRect.Right - tRect.Left, tRect.Bottom - tRect.Top, hdcScreen, tRect.Left, tRect.Top, SRCCOPY)
        IE.Document.Body.Style.Zoom = sngPrevZoom
        Call SetWindowPos(IE.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
        If GetForegroundWindow = IE.hwnd Then
            lIEThreadID = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)
            lXLThreadID = GetWindowThreadProcessId(Application.hwnd, ByVal 0&)
            Call AttachThreadInput(lIEThreadID, lXLThreadID, True)
            Call SetForegroundWindow(Application.hwnd)
            If IsIconic(Application.hwnd) Then
                Call ShowWindow(Application.hwnd, SW_RESTORE)
            Else
                Call ShowWindow(Application.hwnd, SW_SHOW)
            End If
        End If
        
        Call OpenClipboard(0)
        Call EmptyClipboard
        Call SetClipboardData(CF_BITMAP, hbmp)
        Call CloseClipboard
        Call DeleteDC(hdc)
        Call DeleteObject(hbmp)
        Call ReleaseDC(0, hdcScreen)
        If IsClipboardFormatAvailable(CF_BITMAP) <> 0 Then
            ActiveSheet.Paste
        End If
End Sub

Private Function Get_IE_Window(Optional partialURLorName As String) As Object
    'Look for an IE browser window or tab already open at the specified (partial) URL or location name and, if found,
    'return that browser as an InternetExplorer object.  Otherwise return Nothing

    Dim Shell As Object
    Dim IE As Object
    Dim i As Variant 'Must be a Variant to index Shell.Windows.Item() array
    
    Set Shell = CreateObject("Shell.Application")
    i = 0
    Set Get_IE_Window = Nothing
    While i < Shell.Windows.Count And Get_IE_Window Is Nothing
        Set IE = Shell.Windows.Item(i)
        If Not IE Is Nothing Then
            If TypeName(IE) = "IWebBrowser2" And IE.LocationURL <> "" And InStr(IE.LocationURL, "file://") <> 1 Then
                If InStr(IE.LocationURL & IE.LocationName, partialURLorName) > 0 Then
                    Set Get_IE_Window = IE
                End If
            End If
        End If
        i = i + 1
    Wend
End Function
 
Last edited:
Upvote 0
Hi,
It didn't like that, it stopped at:
sngPrevZoom = IE.Document.Body.Style.Zoom
 
Upvote 0
cjcass said:
Hi,
It didn't like that, it stopped at:
sngPrevZoom = IE.Document.Body.Style.Zoom
Click to expand...

What is the error number and description your are getting ? What IE version are you using ? (Help menu==> About internet explorer submenu)
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Stop my VBA Userform objects from moving when switching screens
Replies
3
Views
997
Micron
M
S
  • Solved
Need help - VBA to open folder
Replies
5
Views
495
dmt32
D
L
  • Question
Finding HTML element and moving cursor to element returning wrong position
Replies
3
Views
918
Dan_W
D
C
  • Question
One or more Modules for each sub
Replies
0
Views
691
CrashOD
C
A
  • Question
VBA to copy rows containing data to another workbook
Replies
0
Views
819
antrixx
A

Forum statistics

Threads
1,214,945
Messages
6,122,397
Members
449,081
Latest member
JAMES KECULAH

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top