Using Excel VBA code to close the Popups window in Web Pages

[Akbarmahfuzalam]

Hello Friends,
I am trying to close the Window pop ups while opening the web pages which is having the any sorts of pop ups window. I have around 10000 URL and trying to get the title in an excel sheet.

Code is mentioned below. Help is highly appreciated


Option Explicit

Sub CheckPageData()

Dim cell As Range
Dim IntExp As Object
Dim i, j, k As Long
Dim objCollection As Object
Dim Text1 As String



Sheet1.Range("L2").Value = Now
Application.DisplayAlerts = True
Application.EnableEvents = True


Set IntExp = CreateObject("InternetExplorer.Application")
IntExp.Visible = True


Sheet2.Select
i = 1
For Each cell In Sheet2.Range("B2:F" & Sheet2.Range("B100000").End(xlUp).Row)


j = cell.Column + 3
k = cell.Column + 4

'Here A2 is cell Address where we have stored urls which we need to test.
If cell.Value = "" Then GoTo Case2
If Left(cell.Value, 4) = "http" Then

' Goto web page
IntExp.Navigate cell.Text

'On Error Resume Next
'Below loop will run until page is fully loaded
i = 0
'Do Until IntExp.ReadyState = 3
Do Until IntExp.ReadyState = 4
i = i + 1
If i > 4 Then
Application.SendKeys "{Esc}"
GoTo Case3
End If
Loop



'Now use text which you want to search, error text which you want to compare etc.
Case3:

Dim iAmount() As Variant
Dim iNum1 As Integer

iAmount = Sheet3.Range("A2:B" & Sheet3.Range("A2").End(xlDown).Row)

For iNum1 = 1 To UBound(iAmount, 1)

If InStr(IntExp.Document.Title, iAmount(iNum1, 1)) > 0 Then
cell.Offset(0, k).Value = iAmount(iNum1, 2)
GoTo Case1
End If

If iAmount(iNum1, 1) = "home" And InStr(LCase(IntExp.Document.Title), iAmount(iNum1, 1)) = 1 Then
cell.Offset(0, k).Value = iAmount(iNum1, 2)
GoTo Case1
End If

Next iNum1

For iNum1 = 1 To UBound(iAmount, 1)

If iAmount(iNum1, 1) = "size" And InStr(LCase(IntExp.Document.body.innerText), iAmount(iNum1, 1)) > 0 Then
cell.Offset(0, k).Value = iAmount(iNum1, 2)
GoTo Case1
Else
cell.Offset(0, k).Value = "Invalid URL"
End If

Next iNum1

Case1:
cell.Offset(0, j).Value = IntExp.Document.Title

End If
Sheet1.Range("L5").Value = i
i = i + 1
Case2:
Next cell
Sheet2.Range("Q2").Value = "=IF(COUNTIF($G2:$P2,""Valid URL"")>0,""Valid URL"",IF(COUNTIF($G2:$P2,""Home Page"")>1, ""Home Page"",""Invalid URL""))"
Sheet2.Range("Q2:Q" & Sheet2.Range("B100000").End(xlUp).Row).FillDown
Sheet2.Range("Q2:Q" & Sheet2.Range("B100000").End(xlUp).Row).Copy
Sheet2.Range("Q2").PasteSpecial Paste:=xlPasteValues
Sheet1.Range("L3").Value = Now

IntExp.Quit
Set IntExp = Nothing
Application.DisplayAlerts = False
Application.EnableEvents = False
MsgBox "Run Successfully"
End Sub


Public Function WaitForPageToLoad(IntExp As Object)

Call Sleep(1000)

While IntExp.Busy Or IntExp.ReadyState <> READYSTATE_COMPLETE
DoEvents
If IntExp.Busy Then
DoEvents
Hwnd = FindWindow(vbNullString, "Message from webpage")
If Hwnd <> 0 Then childHWND = FindWindowEx(Hwnd, ByVal 0&, "Button", "closebutton")
If childHWND <> 0 Then SendMessage childHWND, BM_CLICK, 0, 0
End If
Wend

End Function