Access 2010 File Dialog Box

[knarlyd@hotmail.com]

I have the following code which successfully opens the dialog box with filters however when I add a function to help with an Excel import, the filters do not work at all (no files are shown even though they exist in the directory that's opened within the dialog box). If I manually type in the filter (i.e. *.x) it still shows the files.
The function at the bottom was provided by cheekybuddha from another form; without his assistance, I'd be lost on getting the Excel file imported into Access.

Here's the VBA code (the Function is also included at bottom):

Private Sub Command0_Click()
On Error GoTo PROC_ERR

Dim strpathtofile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean

' Change this next line to False if the first row in EXCEL worksheet
' has no field names
blnHasFieldNames = True

strBrowseMsg = "Select the EXCEL file:"

' Set initial start directory dialog box
strInitialDirectory = ""

'Set default file type choices
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xlsb")
strpathtofile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)

If strpathtofile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
Else

If Not fSaveExcelFile(strpathtofile) Then
MsgBox "Unable to save file in correct format", vbOK, "Please check ..."
Exit Sub
End If
End If

'MsgBox strPathToFile, vbInformation, "Import Success"

' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "SM_Import"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strpathtofile, blnHasFieldNames, "A10:M50"

MsgBox "File Imported!", vbInformation, "Import Success"

Exit Sub

PROC_ERR:
 MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & _
           "Description: " & Err.Description
           
End Sub

And now the function:

Function fSaveExcelFile(strpathtofile As String) As Boolean
On Error GoTo Err_fSaveExcelFile

  Dim objXL As Object, blXLNewInstance As Boolean, _
      objWB As Object, blWBAlreadyOpen As Boolean, _
      strFileName As String

  Const xlWorkbookNormal As Long = -4143, _
        cTEMP As String = ".TMP.xls"    
  Const c97_03_format As Long = 56   
  
  On Error Resume Next

  Set objXL = GetObject(, "Excel.Application")
  If Err <> 0 Then
    Set objXL = CreateObject("Excel.Application")
    blXLNewInstance = True
    objXL.Visible = False
    Err = 0
  End If
  objXL.ScreenUpdating = False
  
  strFileName = Dir(strpathtofile)
  Set objWB = objXL.Workbooks(strFileName)
  If objWB Is Nothing Then
    If Err <> 0 Then Err = 0
    Set objWB = objXL.Workbooks.Open(strpathtofile)
  Else
    blWBAlreadyOpen = True
  End If
  
  On Error GoTo Err_fSaveExcelFile

  objWB.CheckCompatibility = False     
  objWB.SaveAs strpathtofile & cTEMP, c97_03_format      '

  objWB.Close
  If Len(Dir(strpathtofile & cTEMP)) Then
    Kill strpathtofile
    Name strpathtofile & cTEMP As strpathtofile
    fSaveExcelFile = True
  End If

Exit_fSaveExcelFile:
  On Error Resume Next
  If Not blWBAlreadyOpen Then objWB.Close
  objWB.CheckCompatibility = True      '   <-- *** ADD THIS LINE ***
  Set objWB = Nothing
  objXL.ScreenUpdating = True
  If blXLNewInstance Then objXL.Quit
  Set objXL = Nothing
  If Len(Dir(strpathtofile)) Then Kill strpathtofile & cTEMP
  Exit Function

Err_fSaveExcelFile:
  Select Case Err.Number
  Case Else
    MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & _
           "Description: " & Err.Description & vbNewLine & vbNewLine & _
           "Function: fSaveExcelFile" & vbNewLine & _
           IIf(Erl, "Line No: " & Erl & vbNewLine, "") & _
           "Module: basExcel", , "Error: " & Err.Number
  End Select
  Resume Exit_fSaveExcelFile
  
End Function

 

[AccessBlaster]

You may have a typo here:

'Set default file type choices
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xlsb")

Microsoft Excel Worksheet (.xlsx)
Microsoft Excel 97-2003 Worksheet (.xls)

 

[knarlyd@hotmail.com]

You may have a typo here:

'Set default file type choices
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xlsb")

Microsoft Excel Worksheet (.xlsx)
Microsoft Excel 97-2003 Worksheet (.xls)

.xlsb is a binary Excel extension however you're partly correct as I really am not looking for binary excel files so I will change that.
Thanks for reply!