Weird filename problem using filesystemobject

[cwadams1955]

I don't know if this should properly go here or maybe the Windows XP forum, but here goes:

I have a small utilities database that I use for reformatting and transferring data. I set up a form with a button. Inside the Click event, I have code to open a folder on the disk, read each file from that folder (Excel spreadsheets) and link it as a table, then read the data from that linked table into a storage table. When I ran the import, I got the following error:

The Microsoft Jet database engine could not find the object "FEMA Region 5 start -"Sept 05$". Make sure the object exists and that you spell its name and the path name correctly."

Looking in the folder, I discovered that file had been named using the expression '05, so obviously the apostrophe was causing a problem. I renamed the file, removing the apostrophe (there was no $ in the file name) and replacing most of that string with "Y1". Ran the app again.

Got the same error message. I renamed the file again. Same error. Closed and restarted Access and tried again. Same error. Restarted computer and retried. Same Error. Opened a command prompt and renamed the short filename to something like "FEMAR~5" to try and clear anything lingering in the FATs, then renamed the file - still in command prompt - back to something that made sense. Tried again, and got the exact same error message. Stepping through the code, it appears that the FileSystemObject is returning the correct filename, but when the TransferSpreadsheet attempts to link the file as a table, it is apparently still trying to find the *original* filename. ????????!!!

Here's the code block; any assistance would be appreciated.

Private Sub btnImport_Click()
On Error GoTo Err_btnImport_Click
    Dim db As Database
    Dim rs As ADODB.Recordset
    Dim conn As ADODB.Connection
    Dim strFileName As String, strTableName As String, strSQL As String, strFilePathAndName As String
    Dim strRateTableName As String, strDescription As String, strClass As String, strUnit As String
    Dim dblRate As Double
    Dim intNameLength As Integer, lngCounter As Long
    Dim Answer
    Dim fso As New FileSystemObject
    Dim fls As Files
    Dim f As File
    
    
    If MsgBox("Are You Sure?", vbOKCancel) = vbOK Then
        ' Hide warnings to keep operator from having to keep answering messages
        DoCmd.SetWarnings False
        ' Clear out any existing records from the rates table
        strSQL = "DELETE * FROM tblBillRates"
        DoCmd.RunSQL strSQL
        
        ' Here we need to parse the folder where the spreadsheets are housed
        
        ' Set up connection strings to open a recordset
        Set conn = CurrentProject.Connection
        Set rs = New ADODB.Recordset
        
        ' Set the folder location
        Set fls = fso.GetFolder("C:\Data Migration\Bill Rates\Rate Tables").Files
        
        For Each f In fls
            ' Extract each file name with no path and remove the extension
            strFilePathAndName = "C:\Data Migration\Bill Rates\Rate Tables\" & f.Name
            strFileName = f.Name
            intNameLength = Len(strFileName)
            strFileName = Mid(strFileName, 1, intNameLength - 4)
            ' Increment the counter
            lngCounter = lngCounter + 1
            ' Build table name
            strTableName = "ExcelRates" & Trim(Str(lngCounter))
            ' Create a linked table from each spreadsheet
            DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, strTableName, strFilePathAndName, True
            'Open the linked table's recordset
            strSQL = "SELECT * FROM " & strTableName
            rs.Open strSQL, conn, adOpenDynamic
            ' Set to start of file
            rs.MoveFirst
            
            Do While Not rs.EOF
                ' The raw file name should be the Rate Table Name
                strRateTableName = strFileName
                
                Me.Label3.Caption = "Importing: " & strFileName
                Me.Repaint
                
                ' Description
                If IsNull(rs.Fields(0)) Then
                    rs.MoveNext
                Else
                    strDescription = rs.Fields(0)
                    strDescription = Replace(strDescription, Chr(34), Chr(140))
                
                    ' Classification
                    If IsNull(rs.Fields(1)) Then
                        strClass = "n/a"
                    Else
                        strClass = rs.Fields(1)
                    End If
                    
                    ' Units billed (hrs, etc.)
                    If IsNull(rs.Fields(2)) Then
                        strUnit = "n/a"
                    Else
                        strUnit = rs.Fields(2)
                    End If
                    
                    ' Bill rate
                    If IsNull(rs.Fields(3)) Then
                        dblRate = 0
                    Else
                        dblRate = rs.Fields(3)
                    End If
                    
                    ' Append the data into the Bill Rates table
                    strSQL = "INSERT INTO tblBillRates ( RateTableName, Classification, Description, Unit, Rate ) " & _
                            "SELECT " & Chr(34) & strRateTableName & Chr(34) & _
                            " AS Expr1, " & Chr(34) & strClass & Chr(34) & _
                            " AS Expr2, " & Chr(34) & strDescription & Chr(34) & _
                            " As Expr3, " & Chr(34) & strUnit & Chr(34) & _
                            " As Expr4, " & dblRate & " As Expr5;"
                    DoCmd.RunSQL strSQL
                    rs.MoveNext
                End If
            Loop

            rs.Close
            Set db = Nothing
            Set db = CurrentDb
            db.TableDefs.Delete strTableName
            Me.Refresh
        Next
        
        conn.Close
        Set db = Nothing
        Set rs = Nothing
        Set conn = Nothing
        Set f = Nothing
        Set fls = Nothing
        Set fso = Nothing
        
        Me.Label3.Caption = "Done!"
        Me.Repaint
    
    End If
    
Exit_btnImport_Click:
    DoCmd.SetWarnings True
    Exit Sub

Err_btnImport_Click:
    MsgBox Err.Description
    Resume Exit_btnImport_Click
    
End Sub

 

[KenReay]

Hi

Hm, clutching at straws here, but is it possible the stange filename has been partly updated into the connection string of the linked table (ie the tdf in DAO terms)?

how about your code modified to so:

docmd.deleteobject acTable, strTableName
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, strTableName, strFilePathAndName, True

you may need to add an error trap for table not found and resume next

as I say, a guess


Regards

Ken Reay
Freelance Solutions Developer
Boldon Information Systems Ltd
Website needs upgrading, but for now -

http://www.kenneth.reay.btinternet.co.uk

UK

 

[cwadams1955]

Okay, I found the problem. The bad filename is being pulled from the worksheet tab name. Even though the Excel file was named FR5Y1.xls, and this was the name I was passing to TransferSpreadsheet, apparently TransferSpreadsheet was trying to use the Internal worksheet name "FEMA Region 5 start -Sept '05" to link the table. I renamed the tab to "Sheet1" and it worked. (headdesk x 10...) Thanks for trying.