Here's another approach that doesn't require a combobox or listbox, however, if there are a lot of sheets can be impractical. I have done this to build a list of about 20 items. More than that and gets too long for display.
Code:
Sub ImportSheet()
Dim diag As Office.FileDialog
Dim strW As String, strS As String, x As Integer, sResponse As String
Dim xlApp As Excel.Application, xlWb As Excel.Workbook, xlSht As Excel.Worksheet
Set diag = Application.FileDialog(msoFileDialogFilePicker)
diag.AllowMultiSelect = False
diag.title = "Select an Excel spreadsheet"
diag.Filters.Clear
diag.Filters.Add "Excel Spreadsheet", "*.xls, *.xlsx, *.xlsm"
If diag.Show Then
x = 1
strW = diag.SelectedItems(1)
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open(strW)
For Each xlSht In xlWb.Worksheets
strS = strS & x & " : " & xlSht.Name & vbCrLf
x = x + 1
Next
End If
sResponse = "?"
Do While sResponse = "?"
sResponse = InputBox("Enter number to select sheet" & vbCrLf & strS, "Select Worksheet", "?")
If sResponse Like "[1-" & x - 1 & "]" Then
strS = Split(strS, vbCrLf)(sResponse - 1)
strS = Split(strS, " : ")(1)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Test", strW, , strS & "$"
ElseIf sResponse <> "" Then
MsgBox "Not a valid entry. Enter a number from list or Cancel."
sResponse = "?"
End If
Loop
End Sub