Export to Excel Code - Please Review

N

news.cavtel.net

I found this code and its what I need it to do except I am getting an error
(0) when I run it. I am calling the code as follows where the file name is
loan.xls and my table in my database that I want to export is Loan1a. THANKS

Any help as to why I am getting this error would be appreciated. I
referenced excel10 and DAO3.6.

Calling As Follows
***************

Dim FileName As String, MyRecs As DAO.Recordset, TestIt As Boolean

FileName = "C:\WAM\loan.xls"
Set MyRecs = CurrentDb.OpenRecordset("Loan1a")
TestIt = SaveRecordsetToExcel(MyRecs, FileName, , False)

If TestIt = True Then
MsgBox "Export Succeeded!"
Else
MsgBox "Miserable Failure!"
End If


Heres the function
**********************

Public Function SaveRecordsetToExcel(RecSet As Object, ByVal FName As
String, _
Optional Template As String = "", Optional OutRange As String =
"A1:A1", _
Optional ColumnHeaders As Boolean = True) As Boolean
Dim RSRange As Excel.Range
Dim AppExcel As Excel.Application, WkBk As Excel.Workbook, WkSht As
Excel.Worksheet, i As Integer
Dim Fld As DAO.Field

On Error GoTo ErrExit
SaveRecordsetToExcel = False

'Make sure that RecSet is a recordset

If TypeName(RecSet) = "Recordset" Then
'Create a new Excel workbook
Set AppExcel = New Excel.Application
If Template <> "" Then
Set WkBk = AppExcel.Workbooks.Add(Template)
Else
Set WkBk = AppExcel.Workbooks.Add
End If
Set WkSht = WkBk.Worksheets(1)

Set RSRange = WkSht.Range(OutRange)

'Write the column names
If ColumnHeaders Then
i = 0
For Each Fld In RecSet.Fields
RSRange.Offset(0, i).Value = Fld.Name
i = i + 1
Next
End If

'Format date columns if not writing into a template
If Template <> "" Then
i = 0
For Each Fld In RecSet.Fields
If Fld.Type = adDate Then
RSRange.Offset(0,
i).Columns(1).EntireColumn.NumberFormat = "mm/dd/yyyy hh:mm"
End If
i = i + 1
Next
End If

'Transfer the data to Excel
RSRange.Offset(1, 0).CopyFromRecordset RecSet

'Save the Workbook and Quit Excel
WkBk.SaveAs FName
AppExcel.Quit
SaveRecordsetToExcel = True
End If
Exit Function

ErrExit:
'exit with false value if failed
On Error Resume Next
MsgBox "Error(" & Err.Number & ") " & Err.Description, vbExclamation +
vbOKOnly, "Function SaveRecordsetToExcel()"
SaveRecordsetToExcel = False
AppExcel.Quit
End Function
 
K

Ken Snell [MVP]

My guess is that this step
If TypeName(RecSet) = "Recordset" Then
is not True when you're running the code.

In your code, if this step is False, it goes right to the error handler and
then of course tells you that you have an Error Number 0 because no error
has occurred -- it's just that your code takes you to the error handler's
part of the procedure in this situation.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top