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

我是VBA领域的新手。 但是我发现了一些有希望的

如何使用vba截图网页

它提供了一个打开IE后如何截图的想法。

但它并没有告诉如何将其保存在本地机器上，并将其附加到新的电子邮件。

我怎么做？

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

Answer 1

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 = "[e-mail]" .Subject = "Test Subject" .Attachments.Add FilePath .Display End With 'objMsg End Sub 

以及以全屏方式拍摄屏幕截图并将其保存为文件的function：

 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 

Answer 2

下面是一个Excelmacros，将剪贴板的图像保存到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 

从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 

现在你有一个文件，其余的是Outlook的民间传说; 你创build一个邮件项目，并把该文件在附件中…

另外请注意，如果您愿意，可以使用PDF格式，只需使用ExportAsFixedFormat 0 （Excel中的xlTypePDF = 0 ）。