Re: Export to Excel Code - Please Review

Tech-Archive recommends: Fix windows errors by optimizing your registry

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.
--

Ken Snell
<MS ACCESS MVP>



"news.cavtel.net" <raider1raider@xxxxxxxxx> wrote in message
news:rLZ2e.62$_V4.2829@xxxxxxxxxxxxxxxxxx
>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.Work***, 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
>
>


.

Quantcast