How do I set a pop up window to focus?

  • Thread starter Thread starter OverMyHead
  • Start date Start date
O

OverMyHead

I have an Excel spreadsheet that queries an access database. Part of the
macro I have created (with the help of a co-worker) has the database import
information from a different spreadsheet. When this happens it opens a prompt
that asks for a date. How do I make it so that pop up window is in focus?
Below is the code I believe is relevant to the problem.


Sub Refresh_Access()
Dim LOC As String
LOC = "\\kftwmfs02\Departments\Dispatch\Shared_Files\Capatalized
Work\Capitalized Work.mdb"
Call Module1.Create_Shell_Access(LOC)
End Sub


Module1:

Public Function Create_Shell_Access(ByVal Location As String)
Dim accs As New Access.Application
Set accs = CreateObject("Access.Application")
accs.Visible = False
accs.OpenCurrentDatabase Location
'Set accs = Nothing
Call Module2.Refresh
End Function




Module2:

Sub Refresh()
'
' Refresh Macro
'
' Keyboard Shortcut: Ctrl+r
'
Sheets("Capitalized Work By Area").Select
Range("A4").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("A6").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("A8").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
 
Im sorry, I gave the wrong code....Here is the relivant code:

Public Function Process_Data()
Dim FILELOC As String
FILELOC = "\\kftwmfs02\Departments\Dispatch\Shared_Files\Capatalized
Work\Daily\Routed Daily report " & Request_Date() & ".xls"
Debug.Print FILELOC
DoCmd.SetWarnings False
DoCmd.OpenQuery "CLEAR Routed Techs"
DoCmd.OpenQuery "CLEAR Routed Work"
DoCmd.SetWarnings True

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Routed
Work", FILELOC, True, "R&D Jobs!A4:R10000"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Routed
Techs", FILELOC, True, "R&D Technicians!A4:R10000"

End Function
Public Function Set_Date() As String
Set_Date = Fix_Date(Month(Now())) & Fix_Date(Day(Now())) &
Right(CStr(Year(Now())), 2)
End Function

Public Function Fix_Date(ByVal Num As Integer) As String
Select Case Num
Case Is < 10
Fix_Date = "0" & CStr(Num)
Case Else
Fix_Date = CStr(Num)
End Select
End Function

Public Function Request_Date() As String
Request_Date = InputBox("Please Enter Date In The Format Of 'MMDDYY'.")

End Function
 
Back
Top