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 Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How To Keep Form On Top Instead of Background

Status
Not open for further replies.
DrMingle

DrMingle

Technical User
May 24, 2009
116
US
I need the UserForm1 to be on top of all the websites which launch...

Code: 
Sub SpeedSearch()



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



'************Quotation
Dim myCell As Range
'************
Application.ScreenUpdating = False

Application.StatusBar = _
    "Percent Completed: " & Format(PctDone, "0%")

UserForm1.Show

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 "[URL unfurl="true"]http://www.WhitePages.com"[/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
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"[/URL]
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 "[URL unfurl="true"]http://www.medicare.gov/Physician/Search/PhysicianHome.asp"[/URL]
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
With WshShell
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Enter}"
End With
Application.Wait (Now + TimeValue("0:00:2"))

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

'************************Last Name Search
With WshShell
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
End With
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 "[URL unfurl="true"]http://www.Google.com"[/URL]
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 "[URL unfurl="true"]http://doctor.webmd.com/physician_finder/home.aspx?sponsor=core"[/URL]
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 "[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
Application.Wait (Now + TimeValue("0:00:0"))
While objIERev.busy
Wend
WshShell.AppActivate "Name or Category"
Application.Wait (Now + TimeValue("0:00:2"))
'***************Zip
With WshShell
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .AppActivate "Name or Category"
End With
Name = Range("I14").Text
WshShell.SendKeys Name
'*********************100miles
WshShell.SendKeys "{Tab}"
Name = 11
WshShell.SendKeys Name
'****************Last Name
With WshShell
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
End With
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
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"))
With WshShell
    .AppActivate "Name or Category"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
    .SendKeys "{Tab}"
End With
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}"

Application.StatusBar = False

End Sub
 
Status
Not open for further replies.

Similar threads

K
  • Locked
  • Question
How to resolve define worksheets array
Replies
1
Views
613
combo
combo
huiettcm
  • Locked
  • Question
Catching the Mouse Click Error in Modal User Form
Replies
1
Views
373
strongm
strongm
Kymenglish
  • Locked
  • Question
Automated data entry code in MS Excel VB - Edge code how to hit enter to remove popups
Replies
3
Views
395
strongm
strongm
Katto
  • Locked
  • Question
VBA permutation of arrays
2
Replies
22
Views
830
Katto
Katto
feipezi
  • Locked
  • Question
How to pull data from MS Access DB and place on an Excel spreadsheet with WHERE clause? 2
Replies
10
Views
514
feipezi
feipezi

Part and Inventory Search

Sponsor

Back
Top