Access 10 to Excel 10 Exportation only partially working

[R_McCallan]

I am exporting some data from Access to Excel, I have used this code before and it worked perfectly. I have 2 tables which I am trying to export, contacts and company details. When clicking export on the contacts form, it works perfectly whereas clicking on the company export button does not work. It is using the exact same code and so I do not see what could be making one work and the other not... does anyone have any ideas? Or suggestions as to what I should check?

Thanks

Rebecca

 

[alansidman]

Please post your code for the export button and we can look and see what is happening. I know that you said it is the same code, but humor us.

Alan

 

[R_McCallan]

 Option Compare Database
Option Explicit

Public Function funexport(strfilter As String, intfunctionid As Integer)
On Error GoTo Err_funErrorChecking
Dim strObjectName As String
Dim strFunctionName As String
Dim strselect As String
Dim rstdata As DAO.Recordset
Dim db As Database
Dim strPath As String
Dim objXL As Object
Dim objActiveWkb As Object
Dim objActiveWrksheet As Object
Dim intcolumn As Integer
Dim rstexport As DAO.Recordset

Set db = CurrentDb

Set rstdata = db.OpenRecordset("select * from usystbl000_export where functionid = " & intfunctionid)
strFunctionName = rstdata!Function
strObjectName = rstdata!ObjectName

Set rstdata = db.OpenRecordset("select * from usystbl000_exportdetail where functionid = " & intfunctionid)

rstdata.MoveFirst
Do Until rstdata.EOF
    strselect = strselect & rstdata!FieldName & ", "
    rstdata.MoveNext
Loop
strselect = Left(strselect, Len(strselect) - 2)

If strfilter = "" Then
    Set rstexport = db.OpenRecordset("SELECT " & strselect & " FROM " & strObjectName)
Else
    Set rstexport = db.OpenRecordset("SELECT " & strselect & " FROM " & strObjectName & " WHERE " & strfilter)
End If

If rstexport.RecordCount > 0 Then

    'browse folder option to create filename
    strPath = BrowseFolder("Please select a folder for EXPORT")
    If strPath <> "Cancelled" Then
    'open excel
    
    Set objXL = CreateObject("Excel.Application")
    objXL.Application.Workbooks.Add
    objXL.Visible = False
    Set objActiveWkb = objXL.Application.ActiveWorkbook
    Set objActiveWrksheet = objActiveWkb.Worksheets("Sheet1")

    objXL.ScreenUpdating = False
    objXL.DisplayAlerts = False
          
    'loop through header fields and create them
        'Export details
      
    With objActiveWrksheet
        .Range("A1").CopyFromRecordset rstexport
        rstdata.MoveFirst
        intcolumn = 1
        Do Until rstdata.EOF
            .Columns(intcolumn).NumberFormat = rstdata!Format
            .Columns(intcolumn).ColumnWidth = rstdata!ColumnWidth
            '.Columns(intcolumn).HorizontalAlignment = rstdata!Alignment
            intcolumn = intcolumn + 1
            rstdata.MoveNext
        Loop
        
           
    End With
                
   
    objActiveWkb.SaveAs strPath & "\" & strFunctionName & "_" & Format(Now, "YYYYMMDDhhmmss") & ".xlsx."
    objActiveWkb.Close SaveChanges:=True
    objXL.Application.Quit
    Set objActiveWrksheet = Nothing: Set objActiveWkb = Nothing: Set objXL = Nothing
   End If
End If

Exit_funErrorChecking:
    Exit Function
    
Err_funErrorChecking:
    Call funErrorChecking(Err.Description, Err.Number, Application.CurrentObjectName, "funexport")
    Resume Exit_funErrorChecking
Resume
End Function

 

[R_McCallan]

Don't worry I have found the answer