How to open a list of URLs and save a screenshot of each on my secondary monitor using Excel VBA

Question

I have a list of URLs in range A1:A60. I want to open each, take a screenshot of the website, close the website and save the screenshot in jpg format.

I'm using my secondary monitor to take a screenshot because I have changed the settings on that to Portrait (not Landscape) in order to capture lengthy articles.

I have tried to make it work with the below code but it returns a blank jpg image.


Option Explicit

'Declare Windows API Functions
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

'Declare Virtual Key Codes
Private Const VK_SNAPSHOT = &H2C

Sub PrintScreen()

    Dim Address As String
    Address = Range("A1").Value
    ActiveWorkbook.FollowHyperlink Address, , True

    AppActivate "Google Chrome"
    keybd_event VK_SNAPSHOT, 1, 0, 0

    ActiveSheet.Paste

    Charts.Add
    Charts(1).AutoScaling = True
    Charts(1).Paste
    Charts(1).Export Filename:="C:\Users\user\Desktop\0coding\Excel (Visual Basic)\ClipBoardToPic.jpg", FilterName:="jpg"
    Charts(1).Delete

End Sub

would selenium be an option and can you provide a couple of test urls? — QHarr, Mar 23 '19 at 07:22
Literally any url will do for testing. Can Selenium be integrated in a VBA code? — , Mar 23 '19 at 07:36

score 1 · Accepted Answer · answered Mar 23 '19 at 07:56

So, installing selenium, ensuring latest chromedriver.exe in selenium folder and vbe > tools > references> add reference to selenium type library. The following loops urls from worksheet, screenshots and saves to specified location. There is no formal orientation setting in vba implementation but you can adjust size settings and also switch between windows.

Option Explicit
Public Sub Screenshots()
    Dim d As WebDriver, urls(), i As Long
    urls = Application.Transpose(ThisWorkbook.Worksheets("Sheet1").Range("A1:A2").Value) '<change this
    Set d = New ChromeDriver

    With d
        .AddArgument "--headless"
        .Start "Chrome"
        .Window.Maximize

        For i = LBound(urls) To UBound(urls)
            If InStr(urls(i), "http") > 0 Then
                .get urls(i)
                .TakeScreenshot.SaveAs ThisWorkbook.Path & "/screenshot" & str(i) & ".jpg"
            End If
        Next
        .Quit
    End With
End Sub

How to open a list of URLs and save a screenshot of each on my secondary monitor using Excel VBA

1 Answers1