Excel to Google to Print- screen (using adobe)

Option Explicit
'requires references: "Microsoft HTML Object Library" & "Microsoft Internet Controls"

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
    ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function ShowWindow Lib "user32" _
    (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub screenShotWords()
  Const url = "https://www.google.com/search?q="
  Const imgScale = 1 ' 0.25 'scale to 25% (to create thumbnail)
  
  Dim ie As InternetExplorer, ws As Worksheet, sz As Long
  Dim img As Picture, oCht As ChartObject
  Dim row, RowCount As Integer
  Dim word, Query, fname As String
  
  Set ws = ThisWorkbook.Sheets("Sheet1")
  Set ie = GetIE()
  
  RowCount = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row 'get the last row number
  With ie
  Pause (2)
  For row = 1 To RowCount
    word = Range("A" & row)
    Query = URLEncode("""" & word & """" & " + Sanction OR Charged OR Fraud OR Criminal OR Penalty OR Lawsuit OR Complaint OR Investigation")
    fname = Application.ThisWorkbook.Path & "\sc_" & ReplaceIllegalCharacters(word, "_") & ".png" 'output filename (can be png/jpg/bmp/gif)
    .navigate url & Query
    Do: DoEvents: Loop While .busy Or .readyState <> 4 'wait for page load
    ShowWindow .hwnd, 5 'activate IE window
    Call keybd_event(44, 0, 0, 0) '44="VK_SNAPSHOT"
    Pause (0.25) 'pause so clipboard catches up
    With ws
      ShowWindow Application.hwnd, 5 'back to Excel
      .Activate
      .Paste
      Set img = Selection
      With img
        Set oCht = ws.ChartObjects.Add(.Left, .Top, .Left + .Width, .Top + .Height)
        oCht.Width = .Width * imgScale 'scale obj to picture size
        oCht.Height = .Height * imgScale
        oCht.Activate
        ActiveChart.Paste
        ActiveChart.Export fname, Mid(fname, InStrRev(fname, ".") + 1)
        oCht.Delete
        .Delete
      End With 'end with img
      .Activate
    End With 'end with ws
    Next 'next row
  If Dir(fname) = "" Then MsgBox fname & " Not created"  'Something went wrong (file not created)
    .FullScreen = False
  .Quit
  End With 'ie
End Sub

Sub Pause(sec As Single)
  Dim t As Single: t = Timer
  Do: DoEvents: Loop Until Timer > t + sec
End Sub

Function GetIE() As Object
'requires references: "Microsoft HTML Object Library" & "Microsoft Internet Controls"
'return an object for the open Internet Explorer window, or create new one
  For Each GetIE In CreateObject("Shell.Application").Windows() 'Loop to find
    If (Not GetIE Is Nothing) And GetIE.Name = "Internet Explorer" Then Exit For 'Found!
  Next GetIE
  If GetIE Is Nothing Then Set GetIE = CreateObject("InternetExplorer.Application") 'Create
  GetIE.Visible = True 'Make IE visible
  GetIE.FullScreen = True
End Function

Function URLEncode(EncodeStr As String) As String
'source: https://blog.adamfurmanek.pl/2018/01/20/url-encode-in-vba/
    Dim i As Integer
    Dim erg As String
    erg = EncodeStr
    ' *** First replace '%' chr
    erg = Replace(erg, "%", Chr(1))
    ' *** then '+' chr
    erg = Replace(erg, "+", Chr(2))
    For i = 0 To 255
        Select Case i
            ' *** Allowed 'regular' characters
            Case 37, 43, 48 To 57, 65 To 90, 97 To 122
            Case 1  ' *** Replace original %
                erg = Replace(erg, Chr(i), "%25")
            Case 2  ' *** Replace original +
                erg = Replace(erg, Chr(i), "%2B")
            Case 32
                erg = Replace(erg, Chr(i), "+")
            Case 3 To 15
                erg = Replace(erg, Chr(i), "%0" & Hex(i))
            Case Else
                erg = Replace(erg, Chr(i), "%" & Hex(i))
        End Select
    Next
    URLEncode = erg
End Function

Function ReplaceIllegalCharacters(ByVal strIn As String, strChar As String) As String
'source: https://stackoverflow.com/questions/50846340/remove-illegal-characters-while-saving-workbook-excel-vba
    Dim strSpecialChars As String
    Dim i As Long
    strSpecialChars = "~""#%&*:<>?{|}/\[]" & Chr(10) & Chr(13)

    For i = 1 To Len(strSpecialChars)
        strIn = Replace(strIn, Mid$(strSpecialChars, i, 1), strChar)
    Next

    ReplaceIllegalCharacters = strIn
End Function