Need Assistance To Launch Web Sites Faster 2

[DrMingle]

It takes a good 8 seconds before I see a web window popup and load after the old sites are cleared out....

...can anyone help speed that up?

Sub SpeedSearch()

Dim objIERev
Dim objIEWP
Dim objIEMD
Dim objIEGov
Dim objIEFSMB
Dim objIEGoogle
Dim objIENPI

'************Quotation
Dim myCell As Range
'************
Set SA = CreateObject("Shell.Application")
For Each IEWP In SA.Windows
If Right(IEWP.FullName, 12) = "iexplore.exe" Then
IEWP.Quit
End If
Next
Set SA = CreateObject("Shell.Application")
For Each IERev In SA.Windows
If Right(IERev.FullName, 12) = "iexplore.exe" Then
IERev.Quit
End If
Next
Set SA = CreateObject("Shell.Application")
For Each IENPI In SA.Windows
If Right(IENPI.FullName, 12) = "iexplore.exe" Then
IENPI.Quit
End If
Next
Application.Wait (Now + TimeValue("0:00:1"))

Set objIERev = CreateObject("InternetExplorer.Application")
objIERev.Visible = False
Set objIEWP = CreateObject("InternetExplorer.Application")
objIEWP.Visible = False
Set objIEMD = CreateObject("InternetExplorer.Application")
objIEMD.Visible = False
Set objIEGov = CreateObject("InternetExplorer.Application")
objIEGov.Visible = False
Set objIEFSMB = CreateObject("InternetExplorer.Application")
objIEFSMB.Visible = False
Set objIEGoogle = CreateObject("InternetExplorer.Application")
objIEGoogle.Visible = False
Set objIENPI = CreateObject("InternetExplorer.Application")
objIENPI.Visible = False
'************************Application Activate
Set WshShell = CreateObject("WScript.Shell")
'******************************************

'***************Pull All Websites Initially*************
objIEWP.navigate2 "

http://www.WhitePages.com"

objIEWP.Visible = True
objIEGov.navigate2 "

http://www.medicare.gov/Physician/Search/PhysicianHome.asp"

objIEGov.Visible = True
objIEGoogle.navigate2 "

http://www.Google.com"

objIEGoogle.Visible = True
objIEMD.navigate2 "

http://doctor.webmd.com/physician_finder/home.aspx?sponsor=core"

objIEMD.Visible = True
objIEMD.navigate2 "

http://doctor.webmd.com/physician_finder/home.aspx?sponsor=core"

objIEMD.Visible = True
objIEFSMB.navigate2 "

http://www.fsmb.org/directory_smb.html"

objIEFSMB.Visible = True
objIERev.navigate2 "

http://www.revolutionhealth.com/doctors"

objIERev.Visible = True
objIENPI.navigate2 "

https://nppes.cms.hhs.gov/NPPES/NPIRegistrySearch.do?subAction=reset&searchType=ind"

objIENPI.Visible = True
'************************************************


'Whitepages.com
objIEWP.navigate2 "

http://www.WhitePages.com"

objIEWP.Visible = True
Application.Wait (Now + TimeValue("0:00:3"))
While objIEWP.busy
Wend
WshShell.AppActivate "Name or Category"
Name = Range("I8")
WshShell.SendKeys Name

'******************last name

WshShell.SendKeys "{TAB}"
Name = Range("I9")
WshShell.SendKeys Name

'**************zip
WshShell.SendKeys "{TAB}"
Name = Range("I14").Text
WshShell.SendKeys Name
WshShell.SendKeys "{Enter}"
'**************

'Medicare.gov
objIEGov.navigate2 "

http://www.medicare.gov/Physician/Search/PhysicianHome.asp"

objIEGov.Visible = True
Application.Wait (Now + TimeValue("0:00:1"))
While objIEGov.busy
Wend
WshShell.AppActivate "Name or Category"
Application.Wait (Now + TimeValue("0:00:1"))
'***************Zip
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Enter}"
Application.Wait (Now + TimeValue("0:00:2"))

'******************Physician
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Enter}"
WshShell.AppActivate "Name or Category"
Application.Wait (Now + TimeValue("0:00:3"))

'************************Last Name Search
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
Application.Wait (Now + TimeValue("0:00:1"))
WshShell.SendKeys "%(L)"
WshShell.SendKeys "{Tab}"
WshShell.AppActivate "Name or Category"
Name = Range("I9")
WshShell.SendKeys Name

'Google.com
objIEGoogle.navigate2 "

http://www.Google.com"

objIEGoogle.Visible = True
Application.Wait (Now + TimeValue("0:00:0"))
While objIEGoogle.busy
Wend

'****************Google Quotes*****************Sub AddQuote()
For Each myCell In Range("J8")
Range("J8") = Range("I8") & " " & Range("I9")
If myCell.Value <> " " Then
myCell.Value = Chr(34) & myCell.Value & Chr(34)
End If
Next myCell
'**********************************************
WshShell.AppActivate "Name or Category"
Name = Range("J8") & " " & Range("I15") & " " & Range("I13")
WshShell.SendKeys Name
WshShell.SendKeys "{Enter}"
'************************

'WebMD.com
objIEMD.navigate2 "

http://doctor.webmd.com/physician_finder/home.aspx?sponsor=core"

objIEMD.Visible = True
Application.Wait (Now + TimeValue("0:00:1"))
While objIEMD.busy
Wend
WshShell.AppActivate "Name or Category"
Application.Wait (Now + TimeValue("0:00:2"))
'****************Zip
WshShell.AppActivate "Name or Category"
Name = Range("I14").Text
WshShell.SendKeys Name
'****************Last Name
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
Name = Range("I9")
WshShell.SendKeys Name
WshShell.SendKeys "{Enter}"

'FSMB.org
objIEFSMB.navigate2 "

http://www.fsmb.org/directory_smb.html"

objIEFSMB.Visible = True

'Revolutionhealth.com
'*******************Rev Search
objIERev.navigate2 "

http://www.revolutionhealth.com/doctors"

objIERev.Visible = True
Application.Wait (Now + TimeValue("0:00:0"))
While objIERev.busy
Wend
WshShell.AppActivate "Name or Category"
Application.Wait (Now + TimeValue("0:00:2"))
'***************Zip
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.AppActivate "Name or Category"
Name = Range("I14").Text
WshShell.SendKeys Name
'*********************100miles
WshShell.SendKeys "{Tab}"
Name = 11
WshShell.SendKeys Name
'****************Last Name
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
Name = Range("I9")
WshShell.SendKeys Name
WshShell.SendKeys "{Enter}"

'************
'NPI Registry
objIENPI.navigate2 "

https://nppes.cms.hhs.gov/NPPES/NPIRegistrySearch.do?subAction=reset&searchType=ind"

objIENPI.Visible = True
Application.Wait (Now + TimeValue("0:00:0"))
While objIENPI.busy
Wend
WshShell.AppActivate "Name or Category"
'**************NPI Number
Application.Wait (Now + TimeValue("0:00:1"))
WshShell.AppActivate "Name or Category"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
WshShell.SendKeys "{Tab}"
If Range("I10") <> 0 Then
WshShell.SendKeys Range("I10")
Else
WshShell.SendKeys "{Tab}"
WshShell.SendKeys Range("I8")
WshShell.SendKeys "{Tab}"
WshShell.SendKeys Range("I9")
End If
WshShell.SendKeys "{Enter}"

End Sub

 

[PHV]

Why looping THREE times to close the IE windows?
ONE should suffice.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[mrmovie]

PHV, might be one of those puke collections which if you remove something from it (ok, not explicitly in this case) the collection count changes and you end up in a different position in the collection than you were before you issued the remove...am just guessing at this (see the same thing with .net form.contols and trying to remove all the controls).

 

[PHV]

OK, this should suffice:

Set SA = CreateObject("Shell.Application")
With SA.Windows
  For i = .Count - 1 To 0 Step -1
    .Item(i).Quit
  Next
End With

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[strongm]

>one of those puke collections ... the collection count changes

Erm ... why would you expect different behaviour than this? If I add or remove items from a collection I'd absolutely expect the Count to change as I do so.

 

[mrmovie]

not suggesting the counter shouldnt change more found it annoying that

For Each aControl In [form].Controls
If aControl.Name.StartsWith("_")
aControl.Delete
End If
Next

does not yield the desired results (i.e. you would need to loop root +1 times )

was just suggesting this is why DrMingle was using the 3 times appoach (maths was never my strongm point)