Как открыть список URL-адресов и сохранить скриншот каждого из них на моем дополнительном мониторе с помощью Excel VBA - PullRequest
Новая
       26

Как открыть список URL-адресов и сохранить скриншот каждого из них на моем дополнительном мониторе с помощью Excel VBA

2 голосов
/ 23 марта 2019

У меня есть список URL в диапазоне A1: A60. Я хочу открыть каждый, сделать скриншот сайта, закрыть сайт и сохранить скриншот в формате jpg.

Я использую свой дополнительный монитор, чтобы сделать снимок экрана, потому что я изменил его настройки на Портрет (не Пейзаж), чтобы захватывать длинные статьи.

Я пытался заставить его работать с приведенным ниже кодом, но он возвращает пустое изображение JPG. 


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

1 Ответ

1 голос
/ 23 марта 2019

Итак, устанавливает селен , гарантируя, что последний файл chromedriver.exe находится в папке селенов, и vbe> tools> reference> добавьте ссылку на библиотеку типов селенов. Следующие циклы URL-адресов из листа, снимки экрана и сохраняет в указанном месте. В реализации vba нет формальной настройки ориентации, но вы можете настроить параметры размера, а также переключаться между окнами. 

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
...