VBA Excel 从网站上抓取屏幕截图

Question

下午好，

我和following code打了一阵子：

 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

它根本不起作用

与下面的另一个相同： 选项显式 '需要引用：“Microsoft HTML 对象库”和“Microsoft Internet 控件”

 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

在这两种情况下，我都有一个错误：未定义用户定义类型指向Dim IE As Object 行。

另外，我的 PrivateSub 函数被标记为红色，出现这个错误：

Microsoft Visual Basic for Applications

编译错误：

此项目中的代码必须更新才能在 64 位上使用 系统。请查看并更新 Declare 语句，然后 用 PtrSafe 属性标记它们。

我尝试使用此链接处理它：

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

但徒劳无功，一切照旧。

我的 Microsoft Internet 控件已打开

如何从网站上截取屏幕截图？还有其他方法吗？

Answer 1

请在您的 win64 代码中添加PtrSafe

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