Option Explicit

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 MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

Private Const WM_CLOSE = &H10
Private Const VK_MENU = &H12
Private Const VK_SNAPSHOT = &H2C
Private Const KEYEVENTF_KEYUP = &H2
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Const SW_SHOWMAXIMIZED = 3


Public Sub SaveImageActiveWindow()
'////////////////////////////////
'// Ivan F Moala //

'// For my friend Colo //
'////////////////////////////////

Dim Altscan As Double
On Error GoTo ErrHandler

'// Copy picture into the clip board.
Altscan = MapVirtualKey(VK_MENU, 0)
keybd_event VK_MENU, Altscan, 0, 0

keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_MENU, Altscan, KEYEVENTF_KEYUP, 0

Application.Wait Now + TimeSerial(0, 0, 1)
SavePicture PastePicture(xlBitmap), "C:Users502390548DesktopAWBTest.bmp"
Exit Sub

ErrHandler:
'// Error handling
MsgBox Err.Number & ":= " & Err.Description

End Sub

Private Sub UserForm_Click()
SaveImageActiveWindow
MsgBox "Done !"
End Sub


Sub Snapshot()


    Dim IE As Object
    Dim hwnd As Long, IECaption As String

    Set IE = CreateObject("InternetExplorer.Application")

    IE.Visible = True

    IE.Navigate "INDIRIZZO DELLA DHL" & Cells(2, 1)

    Sleep 2000

    '~~> Get the caption of IE
    IECaption = "Rintracciare, Rintracciare le spedizioni | Ricerca spedizioni di DHL Express - Windows Internet Explorer"

    '~~> Get handle of IE
    hwnd = FindWindow(vbNullString, IECaption)

    If hwnd = 0 Then
        MsgBox "IE Window Not found!"
        Exit Sub
    Else
        '~~> Maximize IE
        ShowWindow hwnd, SW_SHOWMAXIMIZED
    End If
Sleep 1000
    DoEvents

    '~~> Take a snapshot
    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
    
    
'=========ALTRO CODICE=========================
    
    Dim Altscan As Double
On Error GoTo ErrHandler

'// Copy picture into the clip board.
Altscan = MapVirtualKey(VK_MENU, 0)
keybd_event VK_MENU, Altscan, 0, 0

keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_MENU, Altscan, KEYEVENTF_KEYUP, 0

Application.Wait Now + TimeSerial(0, 0, 1)
SavePicture PastePicture(xlBitmap), "C:Users502390548DesktopDHL " & Cells(2, 1) & ".bmp"
Exit Sub

ErrHandler:
'// Error handling
MsgBox Err.Number & ":= " & Err.Description

End Sub



Sub Snapshot1()


    Dim IE As Object
    Dim hwnd As Long, IECaption As String
    Dim i As String
    i = 2
    
    While i <> ""

    Set IE = CreateObject("InternetExplorer.Application")

    IE.Visible = True

    IE.Navigate "INDIRIZZO DHL" & Cells(i, 1)
  

    Sleep 2000

    '~~> Get the caption of IE
    IECaption = "Rintracciare, Rintracciare le spedizioni | Ricerca spedizioni di DHL Express - Windows Internet Explorer"

    '~~> Get handle of IE
    hwnd = FindWindow(vbNullString, IECaption)

    If hwnd = 0 Then
        MsgBox "IE Window Not found!"
        Exit Sub
    Else
        '~~> Maximize IE
        ShowWindow hwnd, SW_SHOWMAXIMIZED
    End If
Sleep 1000
    DoEvents

    '~~> Take a snapshot
    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
    

    
    
'=========ALTRO CODICE=========================
    
    Dim Altscan As Double
On Error GoTo ErrHandler

'// Copy picture into the clip board.
Altscan = MapVirtualKey(VK_MENU, 0)
keybd_event VK_MENU, Altscan, 0, 0

keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_MENU, Altscan, KEYEVENTF_KEYUP, 0

Application.Wait Now + TimeSerial(0, 0, 1)
SavePicture PastePicture(xlBitmap), "C:Users502390548DesktopPOD DHLDHL " & Cells(i, 1) & ".bmp"
Exit Sub

ErrHandler:
'// Error handling
MsgBox Err.Number & ":= " & Err.Description



Windows("SalvareScreenshot.xls").Activate

i = i + 1
Wend

End Sub