need help, want data to go into seperate cells in .xls

[DK8]

I am exporting data to an .xls spreadsheet and currently the data is all getting lumped into the first cell A1. Is there an easy way to get the data to seperate into different cells? I want first name in A1, last name in B1, SSN in C1, employee paid premium in D1 and cancel date in E1. Then when the system encounters first name a second time, it should start a new row and so on. I have attached the code for your review, thanks in advance for any help that anyone can provide.

Function Build_UNUM_Provident_Payment_File(ByVal lngCarrier As Long)

On Error GoTo ERR_HANDLER

Dim rstRecs As ADODB.Recordset

Dim strFileName As String
Dim strSQL As String

Dim lngEmployerNo As Long

Dim varRetVal As Variant

Dim intRow As Integer
Dim intColumn As Integer
Dim intCounter As Integer

Dim blnOpenLocally As Boolean

blnOpenLocally = OpenGlobalOLEDBConnection()

Set rstRecs = CreateObject("ADODB.RECORDSET")

strSQL = "exec spSelectUNUMProvidentPaymentFile "
strSQL = strSQL & ReturnFieldArgument("@CarrierNumber", lngCarrier, True, False)

With rstRecs
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.ActiveConnection = g_conOLEDB
.Open strSQL

Set .ActiveConnection = Nothing

intRow = 1
intColumn = 1
intRow = intRow + 1
intColumn = intColumn + 1
intCounter = intCounter + 1
lngEmployerNo = 0

If (Not (.EOF)) Then
strFileName = CreateNightBatchDirectory() & "Payments\UNUMProvident" & lngCarrier & "Client" & .Fields("EMPLOYER NUMBER").Value & ".xls"
Open strFileName For Output As #1
Add_Email_Process_Record True, 1, lngCarrier, strFileName, False, CInt(Asc("P") & Asc("F"))
Add_Daily_Process_Record "UNUMProvident" & lngCarrier, strFileName

Do While (Not (.EOF))
lngEmployerNo = .Fields("EMPLOYER NUMBER").Value

If (Not (BlankField(.Fields("FIRST NAME").Value))) Then
Print #1, Format(Left(.Fields("FIRST NAME").Value, 15), "!@@@@@@@@@@@@@@@");
Else
Print #1, Space$(15);
End If
If (Not (BlankField(.Fields("LAST NAME").Value))) Then
Print #1, Format(Left(.Fields("LAST NAME").Value, 15), "!@@@@@@@@@@@@@@@");
Else
Print #1, Space$(15);
End If
Print #1, Format(Left((rstRecs![EMPLOYEE SSN]), 9), "@@-@@@-@@@@");
If (Not (BlankField(.Fields("EMPLOYEE PAID PREMIUM").Value))) Then
Print #1, Format(Left(.Fields("EMPLOYEE PAID PREMIUM").Value, 10), "0000000.00");
Else
Print #1, Space$(10);
End If
If (Not (BlankField(.Fields("CANCEL DATE").Value))) Then
Print #1, Format(Left(.Fields("CANCEL DATE").Value, 10), "MM/DD/YYYY")
Print #1, Space$(2);
Else
Print #1, Space$(12);
End If
Print #1,
Print #1,
.MoveNext
Loop

Close #1
End If
End With

rstRecs.Close

Set rstRecs = Nothing

Exit Function

If (blnOpenLocally) Then
CloseGlobalOLEDBConnection
End If

ERR_HANDLER:
Close #1

If (rstRecs.STATE = adStateOpen) Then
varRetVal = Generate_ADOError_Report(g_conOLEDB, Application.CurrentObjectName & " Build_UNUM_Provident_Payment_File ", _
Err.Number & Err.DESCRIPTION & " SSN- " & rstRecs.Fields("EMPLOYEE SSN").Value)

rstRecs.Close
Else
varRetVal = Generate_ADOError_Report(g_conOLEDB, Application.CurrentObjectName & " Build_UNUM_Provident_Payment_File ", _
Err.Number & Err.DESCRIPTION & " RECORDSET NOT OPEN")
End If

If (blnOpenLocally) Then
CloseGlobalOLEDBConnection
End If

Halt_Night_Batch

End Function

 

[Guus2005]

Looks impressing. However,

You're using

Open strFileName For Output As #1

which creates a text file.

This is the way i export a recordset to Excel:

Public Sub CreateSpreadsheetFromRS(rst As Recordset, blnVisible As Boolean, Optional blnHeader As Boolean = True)
'Recordset export to excel.

    Dim appExcel  As Excel.Application
    Dim wbExcel   As Workbook
    Dim wsExcel   As Worksheet
    Dim qdf       As QueryDef
    Dim intRij    As Integer
    Dim intVelden As Integer
    Dim intTeller As Integer
        
    If Not rst.EOF Then
        Set appExcel = New Excel.Application
        With appExcel
            .Visible = blnVisible
            Set wbExcel = .Workbooks.Add
            Set wsExcel = wbExcel.Worksheets(1)
        End With
    Else
        MsgBox "No records found for " & rst.Name, vbExclamation, GetAppTitle()
        Exit Sub
    End If
    
    intVelden = rst.Fields.Count - 1
        
    intRij = 0
    
    If blnHeader Then 'Default fieldnames get exported
        intRij = intRij + 1
        For intTeller = 0 To intVelden
            wsExcel.Cells(intRij, intTeller + 1) = rst.Fields(intTeller).Name
        Next intTeller
    End If
                
    Do While Not rst.EOF
        intRij = intRij + 1
        For intTeller = 0 To intVelden
            wsExcel.Cells(intRij, intTeller + 1) = rst.Fields(intTeller)
        Next intTeller
        rst.MoveNext
    Loop
        
    wsExcel.Columns.AutoFit
    wsExcel.Rows.AutoFit
    appExcel.Visible = True
    appExcel.WindowState = xlMinimized
    
    Set rst = Nothing
    Set qdf = Nothing

End Sub

HTH !

 

[qdogfball]

If you have a query to export the stuff..

Dim TabName As String

TabName = "RRA"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Qry-TP Task-Daily Report", "C:\Task Reports\" & "TP Cor " & Format(Now(), "mm-dd-yy") & ".xls", True, TabName

Just use a query and give it a directory to save to.

I have included a format for the daily report saved by date, you do not need it. I also have a tab name for the spreadsheet.

BTW, This is NOT supposed to work, but it does!

 

[DK8]

Thanks for your response, I'll look at your code when I have a chance. If you have any other suggestions, please let me know.