For the folks with firewall problems...
Here is the script part 1 of 2...Please note that the script was longer than the 10,000 symbols allowed to post in a single message.
=====start of part 1 =======================
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub StartScan()
On Error Resume Next
Dim ws As Worksheet
Set ws = ActiveSheet
eacYearDay = GetSetting("I485", "Settings", "eacYearDay", "02-001")
eacYearDay = InputBox("Enter ND year and day (first 5 digit of eac #) in format YY-DDD", "Excel", eacYearDay)
If eacYearDay = "" Then Exit Sub
eacYear = CInt(Left(eacYearDay, 2))
eacDay = CInt(Right(eacYearDay, 3))
If Mid(eacYearDay, 3, 1) <> "-" Or Len(eacYearDay) <> 6 Or Err <> 0 Then
MsgBox "Incorrect value"
Exit Sub
End If
SaveSetting "I485", "Settings", "eacYearDay", eacYearDay
sheetName = "eac" & Format(eacYear, "00") & "-" & Format(eacDay, "000")
Set ws = Nothing
Set ws = Worksheets(sheetName)
If Not ws Is Nothing Then
MsgBox "eac list worksheet " & sheetName & " already exists" & vbCrLf & _
"Statuses for only listed eac numbers will be checked and updated" & vbCrLf & _
"If you want to start from scratch just delete or rename this worksheet"
Else
Err.Clear
eacRange = GetSetting("I485", "Settings", "eacRange", "50001-59999")
eacRange = InputBox("Enter range of last 5 digits of eac # in format #####-#####", "Excel", eacRange)
If eacRange = "" Then Exit Sub
eacStart = CLng(Left(eacRange, 5))
eacEnd = CLng(Right(eacRange, 5))
If Mid(eacRange, 6, 1) <> "-" Or Err <> 0 Then
MsgBox "Incorrect value"
Exit Sub
End If
SaveSetting "I485", "Settings", "eacRange", eacRange
End If
If MsgBox("Are you sure you want to start scan process?", vbYesNoCancel) = vbYes Then
Set browser = Nothing
RestartBrowser browser
If ws Is Nothing Then
Set ws = Worksheets.Add
ws.Name = sheetName
PopulateSheet browser, ws, eacYear, eacDay, eacStart, eacEnd
Else
ws.Activate
ws.Range("D1").Select
Selection.RemoveSubtotal
UpdateSheet browser, ws
End If
browser.Visible = False
Set browser = Nothing
MsgBox "Done"
End If
End Sub
Public Sub MakeChart()
Dim ws As Worksheet
Set ws = ActiveSheet
If ws.Cells(1, 1) <> "eac" Then
MsgBox "Please activate eac list worksheet"
End
End If
ws.Range("D1").Select
Selection.RemoveSubtotal
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=4, Function:=xlCount, TotalList:=Array(4), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ws.Outline.ShowLevels RowLevels:=2
lastRow = ws.UsedRange.Rows.Count
total = ws.Cells(lastRow, 4)
If Val(total) < 1 Then
MsgBox "Could not find correct grand total value"
Exit Sub
End If
Charts.Add
With ActiveChart
.ChartType = xlPie
.SetSourceData Source:=ws.Range("C2:C" & (lastRow - 1) & ",D2
" & (lastRow - 1)), PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet
.HasTitle = True
.ChartTitle.Characters.Text = ws.Name & " on " & Now & vbCrLf & "Total: " & total
.HasLegend = False
.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent, LegendKey:=False, HasLeaderLines:=True
.PlotArea.Border.Weight = xlThin
.PlotArea.Border.LineStyle = xlNone
.PlotArea.Interior.ColorIndex = xlNone
End With
End Sub
Sub UpdateSheet(in_browser, in_sheet)
For nextRow = 2 To in_sheet.UsedRange.Rows.Count
eac = in_sheet.Cells(nextRow, 1)
If Left(eac, 3) = "eac" Then
in_sheet.Rows(nextRow).Select
old_status_group = in_sheet.Cells(nextRow, 4)
If InStr(old_status_group, "Approved/Completed") = 0 And _
InStr(old_status_group, "Denied/Withdrawn") = 0 _
Then
Dim new_status, new_status_group, new_date
GetStatus in_browser, eac, new_status, new_status_group, new_date
If new_status <> "" Then
in_sheet.Cells(nextRow, 1) = eac
in_sheet.Cells(nextRow, 2) = new_status
in_sheet.Cells(nextRow, 3) = new_date
in_sheet.Cells(nextRow, 4) = new_status_group
End If
End If
End If
Next
End Sub
Sub PopulateSheet(in_browser, in_sheet, in_year, in_day, in_start, in_end)
in_sheet.Cells.Clear
in_sheet.Cells(1, 1) = "eac"
in_sheet.Cells(1, 2) = "Status"
in_sheet.Cells(1, 3) = "Date"
in_sheet.Cells(1, 4) = "Status Group"
in_sheet.Rows(1).Font.Bold = True
For j = in_start To in_end
Dim eac, status, status_group, status_date
eac = "eac" & Format(in_year, "00") & Format(in_day, "000") & Format(j, "00000")
status = ""
GetStatus in_browser, eac, status, status_group, status_date
If status <> "" Then
nextRow = in_sheet.UsedRange.Rows.Count + 1
in_sheet.Cells(nextRow, 1) = eac
in_sheet.Cells(nextRow, 2) = status
in_sheet.Cells(nextRow, 3) = status_date
in_sheet.Cells(nextRow, 4) = status_group
End If
Next
End Sub
Sub RestartBrowser(in_browser)
On Error Resume Next
If Not in_browser Is Nothing Then
in_browser.Visible = False
Set in_browser = Nothing
End If
Set in_browser = CreateObject("InternetExplorer.Application")
If in_browser Is Nothing Then
MsgBox "Could not start InternetExplorer"
End
End If
in_browser.Visible = True
in_browser.Navigate "https://egov.ins.usdoj.gov/graphics/cris/jsps/caseStat.jsp"
WaitTillReady in_browser
End Sub
Sub WaitTillReady(in_browser)
While in_browser.ReadyState <> 4
If in_browser.Visible = False Then
MsgBox "Script aborted"
End
End If
DoEvents
Sleep 50
Wend
End Sub
==== end of part 1 =======
