Question Amend Code...

[raghuprabhu]

Sub DataToBeSent()
On Error GoTo ErrorHandler
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sState As String
Dim sClub As String
Dim s As String
Dim sSQL As String
Dim dDate As String
Dim i As Integer
Dim activeDir As String
Dim FileNum As Integer
 
activeDir = CurrentProject.Path
 
sSQL = "SELECT AFL.StateName, " _
    & "AFL.TeamName, " _
    & "AFL.PlayerSurname, " _
    & "AFL.EndOfSeason " _
    & "FROM AFL " _
    & "ORDER BY AFL.StateName, AFL.TeamName;"
    
'    Debug.Print sSQL
 'XLSheetDump sSQL, activeDir & "\test.xls"
 Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL, dbOpenDynaset) 'dbOpenSnapshot dbOpenForwardOnly
With rs
    .MoveLast 'force error 3021 if no records
    .MoveFirst
 '    sState = .Fields("StateName")
'    s = sState & vbCrLf
'    sClub = .Fields("TeamName")
'    s = s & sClub
    
    s = "State Name" & vbTab & "Club Name" & String(2, vbTab) & "End Of Season" & String(2, vbTab) & 
 "Player Name" & vbCrLf
    Do Until .EOF
    s = s & .Fields("StateName") & String(2, vbTab) & Left(.Fields("TeamName") & Space(10), 10) & 
 String(2, vbTab) & Left(.Fields("EndOfSeason") & Space(10), 10) & String(2, vbTab) & .Fields
 ("PlayerSurname") & vbCrLf
    .MoveNext
    Loop
End With
SendToFile activeDir & "\OutputGetting.txt", s
rs.Close
 GoTo ThatsIt
ErrorHandler:
    Select Case Err.Number
        Case 3021
        Case Else
            MsgBox "Problem with DataToBeSent()" & vbCrLf _
                 & "Error " & Err.Number & ": " & Err.Description
    End Select
ThatsIt:
If Not rs Is Nothing Then Set rs = Nothing
If Not db Is Nothing Then Set db = Nothing
End Sub

I want to modify this code. Please look at the attachments.

I am sending the query to a txt file.

I am getting "OutputGetting.txt" but I want "OutputRequired.txt"

Thanks a lot in advance for your input.

 

[JHB]

You need some IF construction in your loop to take care of when "StateName" and "TeamName", (and "EndOfSeason"), change.

 

[raghuprabhu]

Hi JHB,

Thank you. I am trying. will let you know when I get it working.