Last active
January 30, 2026 22:11
-
-
Save Tomamais/070591f97526baed9e936612c727143e to your computer and use it in GitHub Desktop.
VBA script to automate checks using Edge
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Option Explicit | |
| ' Windows API for screenshots and window handling | |
| Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr) | |
| Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) | |
| Sub AutomateAppCheck() | |
| Dim ws As Worksheet | |
| Dim lastRow As Long, i As Long | |
| Dim url As String, user As String, pass As String | |
| Set ws = ThisWorkbook.Sheets(1) | |
| lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row | |
| For i = 2 To lastRow | |
| url = ws.Cells(i, "E").Value | |
| user = ws.Cells(i, "F").Value | |
| pass = ws.Cells(i, "G").Value | |
| If url <> "" Then | |
| ' 1. Launch Edge with flags to bypass security warnings and use InPrivate mode | |
| ' --ignore-certificate-errors: Bypasses the SSL/HTTPS warning screen | |
| ' --allow-running-insecure-content: Allows non-HTTPS content | |
| Shell "cmd /c start msedge --inprivate --ignore-certificate-errors --allow-running-insecure-content " & url, vbHide | |
| Sleep 4000 | |
| ' 2. Fail-safe: If Edge still shows the "Advanced" security screen, bypass it | |
| BypassInsecureWarning | |
| ' 3. Handle Basic Auth (The native browser popup) | |
| HandleBasicAuth user, pass | |
| ' 4. Wait for page load | |
| Sleep 4000 | |
| ' 5. Capture Screenshot | |
| CaptureToCell ws.Cells(i, "I") | |
| ' Optional: Clear clipboard to prevent bloat | |
| Application.CutCopyMode = False | |
| End If | |
| Next i | |
| MsgBox "Automation Complete!", vbInformation | |
| End Sub | |
| Sub BypassInsecureWarning() | |
| ' If the ignore flag fails, we send the keystrokes to "Proceed" | |
| ' Sequence: Tab (to Advanced), Enter, Tab (to Proceed link), Enter | |
| ' This is a standard workaround for the Chromium "Not Secure" page | |
| SendKeys "{TAB 3}", True ' Move to Advanced button | |
| Sleep 500 | |
| SendKeys "{ENTER}", True | |
| Sleep 500 | |
| SendKeys "{TAB}", True ' Move to the "Proceed to [url] (unsafe)" link | |
| Sleep 500 | |
| SendKeys "{ENTER}", True | |
| Sleep 2000 | |
| End Sub | |
| Sub HandleBasicAuth(username As String, password As String) | |
| ' (Keep the same UIAutomation logic from the previous response) | |
| ' This handles the actual login popup window. | |
| On Error Resume Next ' Prevent crash if window isn't found | |
| SendKeys username, True | |
| Sleep 500 | |
| SendKeys "{TAB}", True | |
| Sleep 500 | |
| SendKeys password, True | |
| Sleep 500 | |
| SendKeys "{ENTER}", True | |
| On Error GoTo 0 | |
| End Sub | |
| Sub CaptureToCell(targetCell As Range) | |
| ' Alt + PrintScreen captures ONLY the active browser window | |
| keybd_event &H12, 0, 0, 0 ' Alt Down | |
| keybd_event &H2C, 0, 0, 0 ' PrintScreen Down | |
| Sleep 100 | |
| keybd_event &H2C, 0, 2, 0 ' PrintScreen Up | |
| keybd_event &H12, 0, 2, 0 ' Alt Up | |
| Sleep 800 | |
| ' Paste and position | |
| targetCell.Parent.Activate | |
| targetCell.Select | |
| targetCell.Parent.Paste | |
| Dim shp As Shape | |
| Set shp = targetCell.Parent.Shapes(targetCell.Parent.Shapes.Count) | |
| With shp | |
| .LockAspectRatio = msoTrue | |
| .Width = 200 | |
| .Top = targetCell.Top | |
| .Left = targetCell.Left | |
| End With | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment