Bring Focus to Input Box

[vs604]

Hey guys,

My friend wanted a program for his employees that would allow them to input some data. The program would then just search an excel file for matches. If a match was found, then a message would be displayed that said "go ahead and do it." If a match wasn't found, then it would say "don't do it." Also, the employees have access to a user account on the PC that is restricted. So he wanted a desktop icon that would only run the macro, and not bring up the actual excel file (because he doesn't want them having access to any of that). The VBA script in the excel sheet (which I actually got from this forum) and the VBScript work fine. When I double click the icon on the desktop (which runs the macro), the search box comes up, which is what I want. The problem I run into is the search box does not automatically have focus. I have to click on it to input anything. When I input something, and click "Okay," the window loses focus again, and I have to click back on it. I want it to have focus when it is ran, and to maintain focus until I click somewhere else. Any help you guys can give to try and fix this would be greatly appreciated.

VBA Script:

Public Sub FindText()'Run from standard module, like: Module1.


Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer


myAgain:
myText = ""
FirstAddress = ""
foundNum = 0
rngNm = ""
AddressStr = ""
thisLoc = ""
myF = ""
myRD = ""


myText = InputBox("Enter Full Name of Company")


If myText = "" Then Exit Sub


For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, MatchCase:=False)


If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Set Found = .UsedRange.FindNext(Found)


Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With
Next ws


If Len(AddressStr) Then
MsgBox "You can cash it."
GoTo myAgain
Else:
MsgBox "WAIT! Check with boss or don't cash it.", vbExclamation
GoTo myAgain
End If



End Sub

VBScript (saved in notepad as .vbs and used as an icon):

Dim XLDim WB
Set XL = CreateObject("Excel.Application")
Set WB = XL.Workbooks.Open("C:\Users\Bhavani Prasad\Desktop\Check_Cash_Customers.xlsm")
XL.Run "FindText"
WB.Close
XL.Quit
Set WB = Nothing
Set XL = Nothing

 

[vs604]

Bump.