Problem reading back in an Excel file I just created using an ACCESS command

[HunterN]

Hi all,

I am using the following code to write out an Excel file from my ACCESS database:

Sub ExporttoExcel()

    'Working in Excel 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

    Dim myCol As String
    Dim iCols As Long
    Dim sName As String
    Dim i As Long
    
    Dim outFile As String
    Dim holdName As String
    
    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet

    Dim dbs As DAO.Database    'Data access object(DAO)
    Dim rst As DAO.Recordset
    Dim sSQL As String
    
    Const cTabTwo As Byte = 1

    If NewSup Then
        outFile = curPath & hold_Year & "\" & supName
    Else
        If SpiderFile Then
            '* Take out SPIDER from the file name
            holdName = Left(shortFileN, InStr(shortFileN, "SPIDER") - 2)
            outFile = curPath & hold_Year & "\" & holdName
        Else
            outFile = curPath & hold_Year & "\" & shortFileN
        End If
    End If
       
    sSQL = "SELECT [VarName], [Size], [LongDescription], [StartPosition], " _
            & "[StopPosition], [Action], [ShortDesc], [EditedUniverse], " _
            & "[ValidEntries], [DataType], [Variable], [Start_MM], [Start_YY], " _
            & "[Stop_MM], [Stop_YY], [Weight], [Source] " _
            & "FROM Puffin_db_Table"
    
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)

    Set appExcel = Excel.Application
    Set wbk = appExcel.Workbooks.Add
        
    appExcel.DisplayAlerts = True
    appExcel.Visible = True
            
    Set wks = appExcel.Worksheets(cTabTwo)
    
    appExcel.ScreenUpdating = True
    

    '* Copy the Field Names to the Excel sheet and Align and Bold them
    For iCols = 0 To rst.Fields.Count - 1
        wks.Cells(5, iCols + 1).Value = rst.Fields(iCols).Name
        myCol = ColumnNumberToLetters(iCols + 1)
        wks.Columns(myCol).VerticalAlignment = xlVAlignTop
    Next
    wks.Range(wks.Cells(5, 1), _
                wks.Cells(5, rst.Fields.Count)).Font.Bold = True
                
            
    Range("A2").Value = "Public Use File"
                          
    If SpiderFile Then
        Range("A3").Value = holdName
    Else
        Range("A3").Value = ShortN
    End If
    

    wks.Range("A6").CopyFromRecordset rst


    Set Sourcewb = ActiveWorkbook

    With Sourcewb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select

        End If
     End With

' *************************************************************************

    '* Save the new workbook and close it
    TempFilePath = curPath & hold_Year & "\"
    
    If SpiderFile Then
        TempFileName = holdName
    Else
        TempFileName = ShortN
    End If
    
    With Sourrcewb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        .Close SaveChanges:=True
    End With
    
    appExcel.Quit
        
    appExcel.DisplayAlerts = True

    MsgBox "You can find the new file in " & TempFilePath
   
End Sub

The reason I am using the SQL statement is because the database table has one field that I don't want to be copied into Excel.

This writes my Excel file correctly. And it uses the FileExtStr = "xlsx" and FileFormatNum = 51.

So my problem is when trying to read this file back out into Access. I use the following to try to import it back. But it does not pull anything back into Access.

    If Right(wbFilename, 4) = "xlsx" Then
              
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
              "Puffin_db_Table", mySelectedFile, True, "A5:Q" & FinalRow

I think it has to do with the spreadsheet types. I have tried to research this for a couple of days now and have come up with no good results. Can anyone help on reading back in a 'xlsx' file that I created.

I'd appreciate any suggestions.
Thanks, Nancy

 

[xenou]

I rarely do this but one thought is that you aren't giving a worksheet to Access. Try instead (?):

"[COLOR="#FF0000"]Sheet1![/COLOR]A5:Q" & FinalRow

 

[HunterN]

Hi Xenou,

Thanks for your reply Xenou, I was so hopeful this morning that the problem would be so simple. But I added the 'Sheet1' to the statement to pull in the excel workbook and it does not work. In debug it goes over the whole statement and does not give me an error, but does not pull anything in the Access table.

The other thing I was thinking was that the variable 'mySelectedFile' holds the full path name and the name of the file plus the extension. I tried to remove the '.xlsx' extension to see if that would work, but that does not work either.

I'm hoping someone can give me advice on the different File Type constants and how, if you want to create a 'xlsx' (using Excel 2010) and then be able to read the file back into Access by reading in a range.

Any other advice on this subject would be nice.

Thanks, Nancy

 

[xenou]

I always leave the file type blank. This usually works if you are using Access 2007/2010 with Excel 2007/2010 and xlsx files. I would still use the sheet name in the range. You shouldn't be getting files of various types for an automated procedure - if you are, it means the process is not under sufficient control (my opinion). You really need consistency when automating tasks.

DoCmd.TransferSpreadsheet acImport, , "Puffin_db_Table", mySelectedFile, _
True, "[COLOR="#FF0000"]Sheet1![/COLOR]A5:Q" & FinalRow

Also:

The reason I am using the SQL statement is because the database table has one field that I don't want to be copied into Excel.

If the Excel file is missing a field that is in the Access table than a simple "transferspreadsheet" will probably fail (I'm not sure of this - but that would be my guess. Try it on a very simple sample of a simple table with three or four fields and a very plain Excel file with a few rows of dummy data - first do a successful import with all fields included, then take a field out of the Excel file and see if it works).

 

[HunterN]

Thanks Xenou, for your help with my problem. It is solved now.

I opened the Excel workbook that was created through my Access system (that did not have the last column in it). I added the Column name so that it would now be the same size as the database table that I would be reading it into.

I created a test module that opened Excel and this workbook. Then did the transfer of the spreadsheet to the table. Checked the record count and closed the Excel workbook.

It was the problem where the excel workbook columns didn't match the fields in the table.

Sub test_to_Import()

    Dim sPath       As String
    Dim ReadGood    As Boolean
    
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
      
    ' Initialize Excel objects
    Set xl = Excel.Application
    Set xlWb = xl.Workbooks
    
        sPath = "H:\Nancy\ACCESS Testing\2012\Aug 2012 Fertility.xlsx"
        
        xl.Workbooks.Open (sPath)
        xl.Visible = True
                   
        DoCmd.TransferSpreadsheet acImport, , _
              "tmp_TblPuffin", sPath, True, "Sheet1!A5:R13"

        Set db = CurrentDb
        Set rst = db.OpenRecordset("temp_TblPuffin")
        
        With rst
            If .RecordCount = 0 Then
                MsgBox "The Excel workbook was NOT pulled in!", vbCritical
                ReadGood = False
            Else
                Call Update_VarNum
            End If
        End With
        
        Workbooks("Aug 2012 Fertility.xlsx").Close
        xl.Quit

End Sub

Thank you very much for your help here.

Nancy

 

[xenou]

Super. Good luck with your project.
ξ