Website Snapshots

    Option Explicit
    
    Enum SnapShotType
        ScreenShotPNG
        FullPagePDF
    End Enum
    
    Enum PreferredBrowser
        MSEdge
        Chrome
        Brave
    End Enum

    #If VBA7 Then
        Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long
    #Else
        Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long
    #End If

    Sub TestSnapshot()

        Dim URL As String, OutputPath As String

        URL = "https://news.microsoft.com/2001/04/11/farewell-clippy-whats-happening-to-the-infamous-office-assistant-in-office-xp/"
        OutputPath = "D:\TEMP\"

        Debug.Print GetSnapShot(URL, OutputPath, ScreenShotPNG, Chrome)

    End Sub

    Function GetSnapShot(ByVal TargetURL As String, _
                         ByVal OutputPath As String, _
                         Optional ByVal Snap As SnapShotType = ScreenShotPNG, _
                         Optional ByVal BrowserName As PreferredBrowser = Chrome)

        Const ARGUMENT = " --headless --disable-gpu --blink-settings=scriptEnabled=true --window-size=768,1280 "
        
        Dim BrowserPath As String, Browser As String, Filename As String, Extension As String, Ret As Long, PID As Long
        Dim CommandLine As String, CLArguments As String, AdditionalParameter As String

        Browser = Switch(BrowserName = MSEdge, "msedge.exe", BrowserName = Chrome, "chrome.exe", BrowserName = Brave, "brave.exe")
        BrowserPath = DoubleQuote(GetProgramLocation(Browser))
        
        If Len(Trim(BrowserPath)) <= 2 Then
            MsgBox "Unable to locate the designated browser." & vbNewLine & "Exiting the procedure.", _
            vbCritical Or vbOKOnly, "Cannot locate browser."
            Exit Function
        End If
        
        ' The MakeSureDirectoryPathExists API will check whether a given path exists, and if not, will create the necessary directories.
        Ret = MakeSureDirectoryPathExists(OutputPath)
        Extension = IIf(Snap = FullPagePDF, ".pdf", ".png")
        AdditionalParameter = IIf(Snap = FullPagePDF, "--print-to-pdf=", " --screenshot=")
        Filename = DoubleQuote(OutputPath & "SnapShot_" & Format(Now, "yyyymmdd-hhmmss") & Extension, True)
        CLArguments = ARGUMENT & AdditionalParameter & Filename & TargetURL
        CommandLine = BrowserPath & CLArguments
        
        ' Execute the instructions in a minimised window - other options include: vbHide, vbNormalFocus
        Debug.Print "Executing: " & CommandLine
        Shell CommandLine, vbMinimizedNoFocus
        
        GetSnapShot = mid(Trim(Filename), 2, Len(Trim(Filename)) - 2)
        
    End Function

    Function DoubleQuote(Optional ByVal SourceText As String, Optional ByVal TrailingSpace As Boolean = False)

        DoubleQuote = Chr(34) & SourceText & Chr(34) & IIf(TrailingSpace, Chr(32), vbNullString)

    End Function

    Function GetProgramLocation(ByVal ExeFilename As String)
        
        ' This function will check the registry for any registered applications with the given filename;
        ' it will return the full path if successful.
        Const REGISTRYADDRESS = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\"
        
        On Error Resume Next
        GetProgramLocation = CreateObject("WScript.Shell").RegRead(REGISTRYADDRESS & ExeFilename & "\")

    End Function