Access 10 to Excel 10 Exportation only partially working

R_McCallan

New Member
Joined
Aug 17, 2010
Messages
9
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
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,066
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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

New Member
Joined
Aug 17, 2010
Messages
9
Code:
 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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,710
Messages
5,597,702
Members
414,164
Latest member
ARTW

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top