-
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.
hrprabhu,
I was unable to test this, as I can't download your tables. However, try this: - Sub DataToBeSent()
-
On Error GoTo ErrorHandler
-
Dim db As DAO.Database
-
Dim rs As DAO.Recordset
-
Dim s As String
-
Dim sSQL As String
-
Dim dDate As String
-
Dim I As Integer
-
Dim activeDir As String
-
Dim FileNum As Integer
-
Dim sCurrentState As String
-
Dim sCurrentTeam As String
-
-
sCurrentState = ""
-
sCurrentTeam = ""
-
-
activeDir = CurrentProject.Path
-
-
sSQL = "SELECT AFL.StateName, " _
-
& "AFL.TeamName, " _
-
& "AFL.PlayerSurname, " _
-
& "AFL.EndOfSeason " _
-
& "FROM AFL " _
-
& "ORDER BY AFL.StateName, AFL.TeamName;"
-
-
-
Set db = CurrentDb
-
Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
-
-
If Not rs.recodcount = 0 Then
-
With rs
-
.MoveFirst
-
s = "State Name" & vbTab & "Club Name" & _
-
String(2, vbTab) & "End Of Season" & _
-
String(2, vbTab) & "Player Name" & vbCrLf
-
Do Until .EOF
-
s = s & _
-
IIf(sCurrentState <> !StateName, _
-
!StateName & vbCrLf, _
-
String(2, vbTab)) & _
-
IIf(sCurrentTeam <> !TeamName, _
-
Left(!TeamName & Space(10), 10) & String(2, vbTab) & Left(!EndOfSeason & Space(10), 10) & vbCrLf, _
-
String(6, vbTab)) & _
-
!PlayerSurname & vbCrLf
-
If sCurrentState <> !StateName Then
-
sCurrentState = !StateName
-
End If
-
If sCurrentTeam <> !TeamName Then
-
sCurrentTeam = !TeamName
-
End If
-
.MoveNext
-
Loop
-
End With
-
SendToFile activeDir & "\OutputGetting.txt", s
-
End If
-
rs.Close
-
db.Close
-
Set rs = Nothing
-
Set db = Nothing
-
-
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
Notice Lines 11-15 then 37-50.
Hopefully this will get you closer to where you need to be.
7 1092
hrprabhu,
I was unable to test this, as I can't download your tables. However, try this: - Sub DataToBeSent()
-
On Error GoTo ErrorHandler
-
Dim db As DAO.Database
-
Dim rs As DAO.Recordset
-
Dim s As String
-
Dim sSQL As String
-
Dim dDate As String
-
Dim I As Integer
-
Dim activeDir As String
-
Dim FileNum As Integer
-
Dim sCurrentState As String
-
Dim sCurrentTeam As String
-
-
sCurrentState = ""
-
sCurrentTeam = ""
-
-
activeDir = CurrentProject.Path
-
-
sSQL = "SELECT AFL.StateName, " _
-
& "AFL.TeamName, " _
-
& "AFL.PlayerSurname, " _
-
& "AFL.EndOfSeason " _
-
& "FROM AFL " _
-
& "ORDER BY AFL.StateName, AFL.TeamName;"
-
-
-
Set db = CurrentDb
-
Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
-
-
If Not rs.recodcount = 0 Then
-
With rs
-
.MoveFirst
-
s = "State Name" & vbTab & "Club Name" & _
-
String(2, vbTab) & "End Of Season" & _
-
String(2, vbTab) & "Player Name" & vbCrLf
-
Do Until .EOF
-
s = s & _
-
IIf(sCurrentState <> !StateName, _
-
!StateName & vbCrLf, _
-
String(2, vbTab)) & _
-
IIf(sCurrentTeam <> !TeamName, _
-
Left(!TeamName & Space(10), 10) & String(2, vbTab) & Left(!EndOfSeason & Space(10), 10) & vbCrLf, _
-
String(6, vbTab)) & _
-
!PlayerSurname & vbCrLf
-
If sCurrentState <> !StateName Then
-
sCurrentState = !StateName
-
End If
-
If sCurrentTeam <> !TeamName Then
-
sCurrentTeam = !TeamName
-
End If
-
.MoveNext
-
Loop
-
End With
-
SendToFile activeDir & "\OutputGetting.txt", s
-
End If
-
rs.Close
-
db.Close
-
Set rs = Nothing
-
Set db = Nothing
-
-
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
Notice Lines 11-15 then 37-50.
Hopefully this will get you closer to where you need to be.
Hi Twinnyfo,
Thank you very much. It worked like a charm!
I'm glad I could be of assistance. Have a great day!
Hi Twinnyfo,
One more change. If I want to put an alphabet before each player's surname. Begin again when the state changes. How do I modify it???
NSW GWS 16 A.Shaw
NSW GWS 16 B.Cameron
NSW GWS 16 C.Patton
NSW GWS 16 D.Mumford
NSW GWS 16 E.Ward
NSW Swans 1 F.Parker
NSW Swans 1 G.Franklin
NSW Swans 1 H.Tippett
NSW Swans 1 I.McGlynn
NSW Swans 1 J.Goodes
Thanks a lot.
Raghu
Now you're being sneaky!
Try This: - Sub DataToBeSent()
-
On Error GoTo ErrorHandler
-
Dim db As DAO.Database
-
Dim rs As DAO.Recordset
-
Dim s As String
-
Dim sSQL As String
-
Dim dDate As String
-
Dim I As Integer
-
Dim activeDir As String
-
Dim FileNum As Integer
-
Dim sCurrentState As String
-
Dim sCurrentTeam As String
-
Dim iAlpha As Integer
-
-
sCurrentState = ""
-
sCurrentTeam = ""
-
iAlpha = 65
-
-
activeDir = CurrentProject.Path
-
-
sSQL = "SELECT AFL.StateName, " _
-
& "AFL.TeamName, " _
-
& "AFL.PlayerSurname, " _
-
& "AFL.EndOfSeason " _
-
& "FROM AFL " _
-
& "ORDER BY AFL.StateName, AFL.TeamName;"
-
-
Set db = CurrentDb
-
Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
-
-
If Not rs.recodcount = 0 Then
-
With rs
-
.MoveFirst
-
s = "State Name" & vbTab & "Club Name" & _
-
String(2, vbTab) & "End Of Season" & _
-
String(2, vbTab) & "Player Name" & vbCrLf
-
Do Until .EOF
-
s = s & _
-
IIf(sCurrentState <> !StateName, _
-
!StateName & vbCrLf, _
-
String(2, vbTab)) & _
-
IIf(sCurrentTeam <> !TeamName, _
-
Left(!TeamName & Space(10), 10) & String(2, vbTab) & Left(!EndOfSeason & Space(10), 10) & vbCrLf, _
-
String(6, vbTab)) & _
-
Chr(iAlpha) & ". " & !PlayerSurname & vbCrLf
-
iAlpha = iAlpha + 1
-
If sCurrentState <> !StateName Then
-
sCurrentState = !StateName
-
End If
-
If sCurrentTeam <> !TeamName Then
-
sCurrentTeam = !TeamName
-
iAlpha = 65
-
End If
-
.MoveNext
-
Loop
-
End With
-
SendToFile activeDir & "\OutputGetting.txt", s
-
End If
-
rs.Close
-
db.Close
-
Set rs = Nothing
-
Set db = Nothing
-
-
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
NB: Lines 13, 17, 45, 46, 52
Twinnyfo,
Thanks once again.
zmbd 5,501
Expert Mod 4TB
hrprabhu
Hi Twinnyfo,
One more change. If I want to put an alphabet before each player's surname. Begin again when the state changes. How do I modify it??<...>
Hi hrprabhu, TwinnyFo was very generous with time and talent here by providing a complete re-working of you code; however, please keep in mind that we do ask that you make a good faith attempt at obtaining your goal.
Sign in to post your reply or Sign up for a free account.
Similar topics
by: MARK |
last post by:
Hi,
I have a printer consumables database.
I have a form designed to change the status of consumables ie. in use,
dead, stock etc.
I select one of my consumables records from the combo box...
|
by: xenophon |
last post by:
I have a class that is used in an ASP.NET app, a WinForms app, and a
Win32 Service. What is the best way to tell what environment the code
is currently instanced in?
Thanks.
|
by: MARTIN LANNY |
last post by:
Hi everyone,
I am having a real trouble to figure out how to amend this code to
switch from GET to POST method.
--------------------------------------------------------
Public Function...
|
by: MARTIN LANNY |
last post by:
I have this code (below) to login to specified URL with my username and
psw and get the resulting HTML code.
It's using "POST" method.
It works just fine when result (after login) is a page.
...
|
by: Benson Wong |
last post by:
I want to write a tailor-made function or class to amend textedit controls,
so that their properties are consistent or changed by some rules.
My idea is as follows:
TailorMadeRoutine(TextBox1)
...
|
by: AMBLY |
last post by:
Hello!
Would be grateful for help with this one - a Record level Validation problem
I run Access 2000 on XP
A form has two fields:
1) fldLevel – it’s an Option Group with 4 choices = 1, 2,...
|
by: GPD |
last post by:
I thought I had done this before but cant see a way how.
Am sure I once opened a table and amended some data.
Anyone know if possible or how, any permissions needed from 10G EM.
PS
I know...
|
by: bharadwajrv |
last post by:
Hi,
i need to amend the value stored in the element in XSLT and this needs to be carried out with in a <template> code..
Please can you help me how to do this?
in the below code, in...
|
by: William Gill |
last post by:
I seem to be having a mentally bad period lately . My code is beginning
to be terrible convoluted mess, and I shudder to think what it will be
like to go back in a couple months and try to follow...
|
by: lawrencef |
last post by:
I’m new to JavaScript and am trying to creating a dynamic web form in
a number of layers. From what I've read, to submit the entire form I
need to have all the fields (that are in all the different...
|
by: DolphinDB |
last post by:
Tired of spending countless mintues downsampling your data? Look no further!
In this article, you’ll learn how to efficiently downsample 6.48 billion high-frequency records to 61 million...
|
by: ryjfgjl |
last post by:
ExcelToDatabase: batch import excel into database automatically...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: jfyes |
last post by:
As a hardware engineer, after seeing that CEIWEI recently released a new tool for Modbus RTU Over TCP/UDP filtering and monitoring, I actively went to its official website to take a look. It turned...
|
by: ArrayDB |
last post by:
The error message I've encountered is; ERROR:root:Error generating model response: exception: access violation writing 0x0000000000005140, which seems to be indicative of an access violation...
|
by: PapaRatzi |
last post by:
Hello,
I am teaching myself MS Access forms design and Visual Basic. I've created a table to capture a list of Top 30 singles and forms to capture new entries. The final step is a form (unbound)...
|
by: CloudSolutions |
last post by:
Introduction:
For many beginners and individual users, requiring a credit card and email registration may pose a barrier when starting to use cloud servers. However, some cloud server providers now...
|
by: af34tf |
last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you
| |