Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

New Internet Explorer Update has killed this macro

Status
Not open for further replies.
DrMingle

DrMingle

Technical User
May 24, 2009
116
US
This code use to work fine in the previous verion of IE, but we have recently upgraded to the newest version of IE. All the web pages pull as they should, but the issue is none of the forms our getting filled with the sendkeys command (It doesn't appear the AppActivate is working)...Could it be the tab structure of the new IE creating problems for the below code?

Any help would be appreciated.

Code: 
Sub SpeedSearchPhysician()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'**********Error Proofing*********
If Range("I8") = 0 Then
  MsgBox "Please enter missing Physician First Name."
  Exit Sub
End If
If Range("I9") = 0 Then
  MsgBox "Please enter missing Physician Last Name."
  Exit Sub
End If
If Range("I11") = 0 Then
  MsgBox "Please enter missing Physician Address."
  Exit Sub
End If
If Range("I13") = 0 Then
  MsgBox "Please enter missing Physician State."
  Exit Sub
End If
If Range("I14") = 0 Then
  MsgBox "Please enter missing Physician Zip."
  Exit Sub
End If
If Range("I15") = 0 Then
  MsgBox "Please enter missing Physician Degree."
  Exit Sub
End If
'****************************
Dim start_time, end_time
start_time = Now()
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

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 "[URL unfurl="true"]http://www.whitepages.com/reverse-lookup"[/URL]
objIEWP.Visible = True
objIEGov.navigate2 "[URL unfurl="true"]http://www.medicare.gov/Physician/Search/PhysicianHome.asp"[/URL]
objIEGov.Visible = True
objIEGoogle.navigate2 "[URL unfurl="true"]http://www.Google.com"[/URL]
objIEGoogle.Visible = True
objIEMD.navigate2 "[URL unfurl="true"]http://doctor.webmd.com/physician_finder/home.aspx?sponsor=core"[/URL]
objIEMD.Visible = True
objIEFSMB.navigate2 "[URL unfurl="true"]http://www.fsmb.org/directory_smb.html"[/URL]
objIEFSMB.Visible = True
objIERev.navigate2 "[URL unfurl="true"]http://www.revolutionhealth.com/doctors"[/URL]
objIERev.Visible = True
objIENPI.navigate2 "[URL unfurl="true"]https://nppes.cms.hhs.gov/NPPES/NPIRegistrySearch.do?subAction=reset&searchType=ind"[/URL]
objIENPI.Visible = True
'************************************************
'Whitepages.com
objIEWP.navigate2 "[URL unfurl="true"]http://www.whitepages.com/reverse-lookup"[/URL]
objIEWP.Visible = True
While objIEWP.busy
Wend
Application.Wait (Now + TimeValue("0:00:2"))
Wshshell.AppActivate "Name or Category"
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}"
Name = Range("I11")
Wshshell.SendKeys Name
Wshshell.SendKeys "{TAB}"
Name = Range("I14").Text
Wshshell.SendKeys Name
Wshshell.SendKeys "{ENTER}"
'**************
'Medicare.gov
objIEGov.navigate2 "[URL unfurl="true"]http://www.medicare.gov/Physician/Search/PhysicianHome.asp"[/URL]
objIEGov.Visible = True
While objIEGov.busy
Wend
Wshshell.AppActivate "Name or Category"
Application.Wait (Now + TimeValue("0:00:3"))
'***************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:3"))
'******************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:2"))
Wshshell.SendKeys "%(L)"
Wshshell.SendKeys "{Tab}"
Wshshell.AppActivate "Name or Category"
Name = Range("I9")
Wshshell.SendKeys Name
'Google.com
objIEGoogle.navigate2 "[URL unfurl="true"]http://www.Google.com"[/URL]
objIEGoogle.Visible = True
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 "[URL unfurl="true"]http://doctor.webmd.com/physician_finder/home.aspx?sponsor=core"[/URL]
objIEMD.Visible = True
While objIEMD.busy
Wend
Wshshell.AppActivate "Name or Category"
Application.Wait (Now + TimeValue("0:00:3"))
'****************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 "[URL unfurl="true"]http://www.fsmb.org/directory_smb.html"[/URL]
objIEFSMB.Visible = True

'Revolutionhealth.com
'*******************Rev Search
objIERev.navigate2 "[URL unfurl="true"]http://www.revolutionhealth.com/doctors"[/URL]
objIERev.Visible = True
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 "[URL unfurl="true"]https://nppes.cms.hhs.gov/NPPES/NPIRegistrySearch.do?subAction=reset&searchType=ind"[/URL]
objIENPI.Visible = True
While objIENPI.busy
Wend
Wshshell.AppActivate "Name or Category"
'**************NPI Number
Application.Wait (Now + TimeValue("0:00:2"))
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_time = Now()
MsgBox "This CVTY Speed Search was completed in" & " " & (DateDiff("s", start_time, end_time)) & " " & "seconds."
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
 
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Question
CTRL + BREAK from second macro button
Replies
5
Views
654
strongm
strongm
remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
967
dhookom
dhookom
remeng
  • Locked
  • Question
If obsolete - deactivate all but one macro
Replies
6
Views
383
mintjulep
M
aldi07
  • Locked
  • Question
update a front-end databases with a new release using vba
Replies
2
Views
262
aldi07
aldi07
remeng
  • Locked
  • Question
Multiple Users in a Macro enabled Excel Doc
Replies
0
Views
293
remeng
remeng

Part and Inventory Search

Sponsor

Back
Top