VBA 截取网页截图，将其另存为文件并将其附加到新电子邮件中

VBA to take screenshot of a web page, save it as file and attach it in new email

提问by Prateek Narendra

I am new to the world of VBA . However I found something promising :

我是 VBA 世界的新手。但是我发现了一些有希望的东西：

How to take a screenshot of webpage using vba

如何使用vba截取网页截图

It gives an idea on how to take a screenshot after opening IE.

它给出了如何在打开 IE 后截取屏幕截图的想法。

But it doesn't tell how to save it on local machine and attach it to a new email.

但它没有说明如何将其保存在本地计算机上并将其附加到新电子邮件中。

How do I do that?

我怎么做？

Edit - right now, I am using selenium and running a shell script to execute the selenium script from VBA to store it. But this would be better

编辑 - 现在，我正在使用 selenium 并运行一个 shell 脚本来从 VBA 执行 selenium 脚本来存储它。但这会更好

采纳答案by R3uK

Base code for Outlook :

Outlook 的基本代码：

Sub test_Prateek_Narendra()
    Dim FilePath As String
    Dim objMsg As Object
    FilePath = StoreScreenShotFrom_As("www.google.com", "TestScrenShot", "jpg")

    Set objMsg = Application.CreateItem(0) 'olMailItem = 0
    With objMsg
        .To = "[email protected]"
        .Subject = "Test Subject"
        .Attachments.Add FilePath
        .Display
    End With 'objMsg
End Sub

And the function to take the screen shot (in full-screen) and save it as a file :

以及截取屏幕截图（全屏）并将其保存为文件的功能：

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#If VBA7 Then
    Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As LongLong, ByVal dwExtraInfo As LongPtr)
#Else
    Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If
Private Const VK_SNAPSHOT As Byte = 44

Public Function StoreScreenShotFrom_As(URL_Dest As String, Img_Name As String, Img_Type As String)
    Dim IE As Object, IECaption As String
    Dim aXL As Object, aWB As Object, aSh As Object, aChO As Object, Img_Path As String
    Img_Path = VBA.Environ$("temp") & "\" & Img_Name & "." & Img_Type

    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .FullScreen = True
        .Navigate URL_Dest

        '''Possibilities to wait until the page is loaded
            'Do While .Busy Or .readyState <> 4
            '    DoEvents
            'Loop
        '''OR
            'Sleep 5000
        '''OR (custom sub below)
            WasteTime 5

        '''Take a snapshot
        Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
        DoEvents
        .Quit
    End With 'IE

    '''Start Excel
    Set aXL = CreateObject("Excel.Application")
    On Error Resume Next
        With aXL
            .WindowState = -4143 'xlNormal
            .Top = 1
            .Left = 1
            .Height = .UsableHeight
            .Width = .UsableWidth
            .WindowState = -4137  'xlMaximized
    On Error GoTo 0
            Set aWB = .Workbooks.Add
            Set aSh = aWB.Sheets(1)
            Set aChO = aSh.ChartObjects.Add(0, 0, .Width, .Height)
        End With 'aXL

    With aChO
        .Activate
        .Chart.Paste
        With .ShapeRange
            .Line.Visible = msoFalse
            .Fill.Visible = msoFalse
        End With '.ShapeRange
        With .Chart
            .Export FileName:=Img_Path, Filtername:=Img_Type, Interactive:=False
        End With '.Chart
        DoEvents
        .Delete
    End With 'oChrtO
    aWB.Close False
    DoEvents
    aXL.Quit

    StoreScreenShotFrom_As = Img_Path
End Function

Private Sub WasteTime(SecondsToWait As Long)
    Dim TimeLater As Date
    TimeLater = DateAdd("s", SecondsToWait, Now)
    Do While Now < TimeLater
        DoEvents
    Loop
End Sub

回答by A.S.H

Here's an Excel macro to save the clipboard's image into an XPSfile:

这是一个 Excel 宏，用于将剪贴板的图像保存到XPS文件中：

Sub xlSaveClipboardImageToXPS()
    Application.DisplayAlerts = False: Application.ScreenUpdating = False: Application.EnableEvents = False
    On Error GoTo Cleanup

    With Sheets.Add
        .Paste
        With .PageSetup
            .Orientation = xlLandscape: .Zoom = False
            .FitToPagesWide = 1: .FitToPagesTall = 1
        End With
        .ExportAsFixedFormat xlTypeXPS, "C:\myScreen.xps"
        .Delete
    End With

Cleanup:
    Application.DisplayAlerts = True: Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

From outlook, you can achieve it by using Excel's services, this way:

从 Outlook 中，您可以通过使用 Excel 的服务来实现，如下所示：

Sub olSaveClipboardImageToXPSUsingExcel()
    With CreateObject("Excel.Application")
        .DisplayAlerts = False
        With .Workbooks.Add.Worksheets(1)
            .Paste
            With .PageSetup
                .Orientation = 2: .Zoom = False
                .FitToPagesWide = 1: .FitToPagesTall = 1
            End With
           .ExportAsFixedFormat 1, "C:\SO\myScreen.xps"
        End With
        .Quit
    End With
End Sub

Now that you have a file, the rest is Outlook folklore; you create a mail item and put the file in attachment...

现在您有了一个文件，剩下的就是 Outlook 民间传说；您创建一个邮件项目并将文件放在附件中...

Also note that you can use PDF format if you prefer, just use ExportAsFixedFormat 0(xlTypePDF = 0in Excel).

另请注意，如果您愿意，您可以使用 PDF 格式，只需使用ExportAsFixedFormat 0(xlTypePDF = 0在 Excel 中)。