VBA Excel grab the screenshot from the website

Question

Good afternoon,

I have been fighting with the following code for a while:

 Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags 
 As Long, ByVal dwExtraInfo As Long)

 Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

 Private Const VK_SNAPSHOT As Byte = 44

 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, 
 ByVal lpWindowName As String) As Long

 Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

 Private Const SW_SHOWMAXIMIZED = 3
 Private Const VK_LCONTROL As Long = &HA2
 Private Const VK_V = &H56
 Private Const KEYEVENTF_KEYUP = &H2

 Sub Sample()
   Dim IE As Object
   Dim hwnd As Long, IECaption As String

  Set IE = CreateObject("InternetExplorer.Application")

  IE.Visible = True

  IE.Navigate "www.Google.com"

  Sleep 5000

  '~~> Get the caption of IE
  IECaption = "Google - Internet Explorer"

  '~~> Get handle of IE
  hwnd = FindWindow(vbNullString, IECaption)

  If hwnd = 0 Then
    MsgBox "IE Window Not found!"
    Exit Sub
  Else
    '~~> Maximize IE
    ShowWindow hwnd, SW_SHOWMAXIMIZED
  End If
 Sleep 3000
 DoEvents

  '~~> Take a snapshot
  Call keybd_event(VK_SNAPSHOT, 0, 0, 0)

  '~~> Start Word


  Set wordobj = CreateObject("Word.Application")

  Set objDoc = wordobj.Documents.Add

  wordobj.Visible = True

  Set objSelection = wordobj.Selection

 'Paste into Word
 objSelection.Paste

End Sub

and it doesn't work at all

The same as the other one below: Option Explicit 'requires references: "Microsoft HTML Object Library" & "Microsoft Internet Controls"

 Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
 ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

 Sub getSS()
 Const url = "stackoverflow.com" 'page to get screenshot of (http is added below)
 Const fName = "x:\thumb_" & url & ".png" 'output filename (can be png/jpg/bmp/gif)
 Const imgScale = 0.25 'scale to 25% (to create thumbnail)

 Dim ie As InternetExplorer, ws As Worksheet, sz As Long
 Dim img As Picture, oCht As ChartObject
 Set ws = ThisWorkbook.Sheets("Sheet1")
 Set ie = GetIE()
 With ie
.navigate "http://" & url
Do: DoEvents: Loop While .busy Or .readyState <> 4 'wait for page load
ShowWindow .hwnd, 5 'activate IE window
Call keybd_event(44, 0, 0, 0) '44="VK_SNAPSHOT"
Pause (0.25) 'pause so clipboard catches up
With ws
  ShowWindow Application.hwnd, 5 'back to Excel
  .Activate
  .Paste
  Set img = Selection
  With img
    Set oCht = ws.ChartObjects.Add(.Left, .Top, .Left + .Width, .Top + .Height)
    oCht.Width = .Width * imgScale 'scale obj to picture size
    oCht.Height = .Height * imgScale
    oCht.Activate
    ActiveChart.Paste
    ActiveChart.Export fName, Mid(fName, InStrRev(fName, ".") + 1)
    oCht.Delete
    .Delete
  End With
  .Activate
   End With
.FullScreen = False
.Quit
  End With
 If Dir(fName) = "" Then Stop 'Something went wrong (file not created)
 sz = FileLen(Name)
 If sz = 0 Then Stop 'Something went wrong! (invalid filename maybe?)
 Debug.Print "Created '" & fName & "' from '" & url & "' (" & sz & " bytes)": Beep
 End Sub

 Sub Pause(sec As Single)
 Dim t As Single: t = Timer
 Do: DoEvents: Loop Until Timer > t + sec
 End Sub

 Function GetIE() As Object
'requires references: "Microsoft HTML Object Library" & "Microsoft Internet Controls"
'return an object for the open Internet Explorer window, or create new one
 For Each GetIE In CreateObject("Shell.Application").Windows() 'Loop to find
 If (Not GetIE Is Nothing) And GetIE.Name = "Internet Explorer" Then Exit For 'Found!
 Next GetIE
 If GetIE Is Nothing Then Set GetIE=CreateObject("InternetExplorer.Application") 'Create
 GetIE.Visible = True 'Make IE visible
 GetIE.FullScreen = True
 End Function

In both cases, I am having an error:User-defined type not defined pointing the line Dim IE As Object.

Moreover, my PrivateSub functions are marked with red, which comes with this error:

Microsoft Visual Basic for Applications

Compile error:

The code in this project must be updated for use on 64-bit systems. Please review and update Declare statements and then mark them with the PtrSafe attribute.

I tried to deal with it using this link:

https://learn.microsoft.com/en-us/previous-versions/office/troubleshoot/office-developer/compile-error-editing-vba-macro

but in vain, everything still the same.

My Microsoft internet controls are switched on

How can I grab the screenshot from the website? Is there any other way to do it?

Answer 1

Please add PtrSafe in your code for win64

Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
  Private Const VK_SNAPSHOT = &H2C