Public Sub ExportarExcel(rs As Recordset)
    Dim xlApp As Object 'Excel.Application
    Dim xlWk As Object 'Excel.Workbook
    Dim xlWs As Object 'Excel.Worksheet
    Dim i As Long, j As Long, l As Long
    Dim fld as Field
    Dim rcs As Recordset
    
    On Error GoTo TratarError
    Screen.MousePointer = vbHourglass
    Set xlApp = CreateObject("Excel.Application")
    Set xlWk = xlApp.Workbooks.Add
    Set xlWs = xlApp.ActiveSheet

    With xlApp.ActiveSheet
        i = 0
        For each fld in rcs.Fields
                i = i + 1
                .Cells(1, i).Value = fld.Name
                .Cells(1, i).EntireColumn.AutoFit
        Next
        On Error Resume Next
        rcs.MoveFirst
        j = 1
        While Not rcs.EOF
            j = j + 1
            For l = 1 To i
                .Cells(j, l).Value = rcs.Fields(.Cells(1, l).Value)
            Next
            rcs.MoveNext
        Wend
    
    End With
    xlApp.Visible = True

Fin:
    Set rcs = Nothing
    Set xlWk = Nothing
    Set xlWs = Nothing
    Set xlApp = Nothing
    Screen.MousePointer = vbDefault
    Exit Sub
TratarError:
    MsgBox Err.Number & ": " & Err.Description, vbCritical + vbOKOnly, "ExportarExcel"
    Resume Fin
    Resume
End Sub