J
Jack
Hi,
I am working on a code that exports data from access to excel. However I am
getting the above error when I run this code from an Access button I cannot
seem to figure out why this is happening. I get the required result in
excel.
CODE:
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
blnEXCEL = False
blnHeaderRow = True
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("c:\_0__AccessExcel\excelfile1.xls")
Set xls = xlw.Worksheets("a")
Set xlc = xls.Range("A1") ' this is the first cell into which data go
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("ExcelExp", dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
End If
' ' write data to worksheet
Do While rst.EOF = False
Dim var1 As String
Dim var2 As String
var1 = rst(0)
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
var2 = rst(0)
If var1 <> var2 Then
Set xlc = xlc.Offset(4, 0)
Else
Set xlc = xlc.Offset(1, 0)
End If
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
End Sub
I appreciate any help for resolution of this error. Thanks.
I am working on a code that exports data from access to excel. However I am
getting the above error when I run this code from an Access button I cannot
seem to figure out why this is happening. I get the required result in
excel.
CODE:
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
blnEXCEL = False
blnHeaderRow = True
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("c:\_0__AccessExcel\excelfile1.xls")
Set xls = xlw.Worksheets("a")
Set xlc = xls.Range("A1") ' this is the first cell into which data go
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("ExcelExp", dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
End If
' ' write data to worksheet
Do While rst.EOF = False
Dim var1 As String
Dim var2 As String
var1 = rst(0)
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
var2 = rst(0)
If var1 <> var2 Then
Set xlc = xlc.Offset(4, 0)
Else
Set xlc = xlc.Offset(1, 0)
End If
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
End Sub
I appreciate any help for resolution of this error. Thanks.