需要截取网页截图并将其粘贴到Word中

时间:2017-08-07 16:42:18

标签: vba excel-vba excel

我正在尝试截取网页的屏幕截图并将其粘贴到Word中。以下是编写的代码

    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 objIE As InternetExplorerMedium
    Set objIE = New InternetExplorerMedium
objIE.Visible = True
    objIE.navigate "https://staging-site.com/"

    Do
    DoEvents
    Loop Until objIE.readyState = 4

    Dim hwnd As Long, IECaption As String

    '~~> Get the caption of IE
    IECaption = objIE.document.Title

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

    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)

Dim SystemDateTime As String

sPath = Environ("USERPROFILE") & "\Desktop"

Set wordobj = CreateObject("Word.Application")

Set objDoc = wordobj.Documents.Add

SystemDateTime = Replace(Replace(Now, "/", ""), ":", "")

objDoc.SaveAs (sPath & "\Student Blue Waiver " & SystemDateTime)

wordobj.Visible = True

Set objSelection = wordobj.Selection

'Paste into Word
objSelection.Paste
objDoc.Save
End Sub

但是下面的变量'hwnd'总是返回0,即使带有标题的IE窗口可见

hwnd = FindWindow(IECaption, vbNullString)
If hwnd = 0 Then
MsgBox "IE Window Not found!"
Exit Sub

我认为IECaption只获得了可能成为FindWindow所需标题的窗口标题

1 个答案:

答案 0 :(得分:1)

看起来你正在向"IEFrame" API函数

传递错误的参数

第一个参数应为vbNullString第二个参数应为窗口名称。在您的代码中,您将文档标题作为类名传递,并将空字符串(CreateObject)作为窗口名称传递!

NB我使用InternetExplorerMedium来实例化InternetExplorer.Application类。这可能与您" - Internet Explorer"略有不同,我不知道。

我还发现我必须将Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub foo() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.navigate "http://cnn.com" Do DoEvents Loop Until objIE.readyState = 4 Dim hwnd As Long, IECaption As String '~~> Get the caption of IE IECaption = objIE.Document.Title & " - Internet Explorer" '~~> Get handle of IE hwnd = FindWindow("IEFrame", IECaption) If hwnd = 0 Then MsgBox "IE Window Not found!" Exit Sub Else 附加到标题值,否则无法找到。

{{1}}