Access DB cant return focus to inputbox - excel

Question

I am using an Access Db to export some information to an Excel Workbook. I am using an input form to add dates to the query that creates the sheet. If I create 1 sheet the export works. If I create more than one sheet once the query goes to the second sheet the focus stays on the excel spreadsheet. If you enter a date it goes on cell A1 of the spreadsheet instead of the input box. Any help is appreciated.
Public Function ExportSpreadSheet(path As String)
Dim xlPath As String, I As Integer
Dim DB As Database
Dim myrs As Recordset ' Create a recordset to hold the data
Dim strSQL As String
Dim myExcel As New Excel.Application ' Create Excel with Early binding
Dim wrkbk As Object
Dim wrksht As Object
Dim targetworkbook As Excel.Workbook
Dim FileRange, name As String
Dim extraChar, queryForTransfer, searchSheet As String
Dim objXL As Object
Dim objAC As Object
Dim x As Integer
Dim myFileName As String
Dim sheetDate As String
Dim sheetName As String
Dim amtofsheets As Long
Dim s As Long
Dim ctlCurrentControl As Control
Dim strAnswer As String
On Error GoTo Err_ExportSpreadSheet
DoCmd.SetWarnings False
xlPath = path
amtofsheets = InputBox("Enter amount of sheets", "Amount of Sheets")
Set DB = CurrentDb
Set objAC = CreateObject("Access.application", "")
For s = 1 To amtofsheets
strAnswer = Forms("Browse1").txtFileSelection
sheetDate = InputBox("Enter Trade Date of Entries ex 10/04/2017", "Trade Date")
If s = 1 Then Set objXL = CreateObject("Excel.application", "")
If s = 1 Then objXL.Visible = True
If s = 1 Then objXL.DisplayAlerts = True
If s = 1 Then Set targetworkbook = objXL.Workbooks.Add
'Add worksheet if need more than three worksheets
strSQL = "SELECT FXOpenDeals.city, FXOpenDeals.[As of Date], FXOpenDeals.[Cnt Pty name], FXOpenDeals.[deal number], FXOpenDeals.value, FXOpenDeals.ccy1, FXOpenDeals.[ccy1 amt], FXOpenDeals.ccy2, FXOpenDeals.[ccy2 amt], FXOpenDeals.[unrealized G/L_PV] " _
& " FROM [A1-Internal_Customers] INNER JOIN FXOpenDeals ON [A1-Internal_Customers].[counterparty number] = FXOpenDeals.[counterparty number] " _
& " WHERE FXOpenDeals.[trade] = #" & Format(sheetDate, "mm/dd/yyyy") & "#" _
& " ORDER BY FXOpenDeals.[Cnt Pty name];"
Set myrs = DB.OpenRecordset(strSQL)
If amtofsheets = 1 Or amtofsheets = 2 Then
For I = 1 To targetworkbook.Worksheets.Count
sheetName = "Sheet" & I
Select Case sheetName
Case "Sheet2"
targetworkbook.Sheets("Sheet2").Delete
Case "Sheet3"
targetworkbook.Sheets("Sheet3").Delete
End Select
Next I
End If
If s > 3 Then
With targetworkbook
.Sheets.Add After:=Sheets(Worksheets.Count)
ActiveSheet.name = "Sheet" & s
End With
End If
'Get spreadsheet headers
x = 0
For Each Field In myrs.Fields 'RS being my Recordset variable
targetworkbook.Worksheets("Sheet" & s).Range("A1").Offset(0, x).Value = Field.name
x = x + 1
Next Field
targetworkbook.Worksheets("Sheet" & s).Range("A2").CopyFromRecordset myrs
targetworkbook.Worksheets("Sheet" & s).Columns("A:K").AutoFit
'Name Worksheet
sheetName = Format(sheetDate, "mm-dd")
targetworkbook.Sheets("Sheet" & s).name = sheetName
Next s
DoCmd.SetWarnings False
myFileName = "Internal Customer FX Deals"
targetworkbook.SaveAs FileName:=xlPath & myFileName, FileFormat:=xlWorkbookNormal
targetworkbook.Close SaveChanges:=False
DoCmd.SetWarnings True
If Not objXL Is Nothing Then
objXL.Quit
objXL.DisplayAlerts = True
Set objXL = Nothing
Set myrs = Nothing
End If
MsgBox "Internal Customer FX Deals Data successfully Exported", vbOKOnly
Exit_ExportSpreadSheet:
Exit Function
Err_ExportSpreadSheet:
Err.Clear
Resume Exit_ExportSpreadSheet
End Function

Answer 1

Seems to me that you are doing a whole lot of work for nothing. There's not need to automate Excel unless you want to do some formatting. Simply export the query to Excel via TransferSpreadsheet. Instead of the input box, use a parameter in the query, or better yet, a small form with a textbox.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "yourQueryName", "FileName", True, "SheetName"