473,320 Members | 1,909 Online
Bytes | Software Development & Data Engineering Community
Post Job

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 473,320 software developers and data experts.

How do I amend this code????

Expand|Select|Wrap|Line Numbers
  1. Sub DataToBeSent()
  2. On Error GoTo ErrorHandler
  3. Dim db As DAO.Database
  4. Dim rs As DAO.Recordset
  5. Dim sState As String
  6. Dim sClub As String
  7. Dim s As String
  8. Dim sSQL As String
  9. Dim dDate As String
  10. Dim i As Integer
  11. Dim activeDir As String
  12. Dim FileNum As Integer
  13.  
  14.  
  15. activeDir = CurrentProject.Path
  16.  
  17.  
  18. sSQL = "SELECT AFL.StateName, " _
  19.     & "AFL.TeamName, " _
  20.     & "AFL.PlayerSurname, " _
  21.     & "AFL.EndOfSeason " _
  22.     & "FROM AFL " _
  23.     & "ORDER BY AFL.StateName, AFL.TeamName;"
  24.  
  25. '    Debug.Print sSQL
  26.  
  27. 'XLSheetDump sSQL, activeDir & "\test.xls"
  28.  
  29. Set db = CurrentDb
  30. Set rs = db.OpenRecordset(sSQL, dbOpenDynaset) 'dbOpenSnapshot dbOpenForwardOnly
  31. With rs
  32.     .MoveLast 'force error 3021 if no records
  33.     .MoveFirst
  34.  
  35. '    sState = .Fields("StateName")
  36. '    s = sState & vbCrLf
  37. '    sClub = .Fields("TeamName")
  38. '    s = s & sClub
  39.  
  40.     s = "State Name" & vbTab & "Club Name" & String(2, vbTab) & "End Of Season" & String(2, vbTab) & "Player Name" & vbCrLf
  41.     Do Until .EOF
  42.     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
  43.     .MoveNext
  44.     Loop
  45. End With
  46. SendToFile activeDir & "\OutputGetting.txt", s
  47. rs.Close
  48.  
  49. GoTo ThatsIt
  50. ErrorHandler:
  51.     Select Case Err.Number
  52.         Case 3021
  53.         Case Else
  54.             MsgBox "Problem with DataToBeSent()" & vbCrLf _
  55.                  & "Error " & Err.Number & ": " & Err.Description
  56.     End Select
  57. ThatsIt:
  58. If Not rs Is Nothing Then Set rs = Nothing
  59. If Not db Is Nothing Then Set db = Nothing
  60. End Sub
  61.  
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.
Attached Files
File Type: txt OutputRequired.txt (1.6 KB, 272 views)
File Type: txt OutputGetting.txt (3.4 KB, 245 views)
File Type: zip AFL.zip (96.6 KB, 69 views)
Sep 18 '14 #1

✓ answered by twinnyfo

hrprabhu,

I was unable to test this, as I can't download your tables. However, try this:

Expand|Select|Wrap|Line Numbers
  1. Sub DataToBeSent()
  2. On Error GoTo ErrorHandler
  3.     Dim db As DAO.Database
  4.     Dim rs As DAO.Recordset
  5.     Dim s As String
  6.     Dim sSQL As String
  7.     Dim dDate As String
  8.     Dim I As Integer
  9.     Dim activeDir As String
  10.     Dim FileNum As Integer
  11.     Dim sCurrentState As String
  12.     Dim sCurrentTeam As String
  13.  
  14.     sCurrentState = ""
  15.     sCurrentTeam = ""
  16.  
  17.     activeDir = CurrentProject.Path
  18.  
  19.     sSQL = "SELECT AFL.StateName, " _
  20.         & "AFL.TeamName, " _
  21.         & "AFL.PlayerSurname, " _
  22.         & "AFL.EndOfSeason " _
  23.         & "FROM AFL " _
  24.         & "ORDER BY AFL.StateName, AFL.TeamName;"
  25.  
  26.  
  27.     Set db = CurrentDb
  28.     Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
  29.  
  30.     If Not rs.recodcount = 0 Then
  31.         With rs
  32.             .MoveFirst
  33.             s = "State Name" & vbTab & "Club Name" & _
  34.                 String(2, vbTab) & "End Of Season" & _
  35.                 String(2, vbTab) & "Player Name" & vbCrLf
  36.             Do Until .EOF
  37.                 s = s & _
  38.                     IIf(sCurrentState <> !StateName, _
  39.                         !StateName & vbCrLf, _
  40.                         String(2, vbTab)) & _
  41.                     IIf(sCurrentTeam <> !TeamName, _
  42.                         Left(!TeamName & Space(10), 10) & String(2, vbTab) & Left(!EndOfSeason & Space(10), 10) & vbCrLf, _
  43.                         String(6, vbTab)) & _
  44.                     !PlayerSurname & vbCrLf
  45.                 If sCurrentState <> !StateName Then
  46.                     sCurrentState = !StateName
  47.                 End If
  48.                 If sCurrentTeam <> !TeamName Then
  49.                     sCurrentTeam = !TeamName
  50.                 End If
  51.                 .MoveNext
  52.             Loop
  53.         End With
  54.         SendToFile activeDir & "\OutputGetting.txt", s
  55.     End If
  56.     rs.Close
  57.     db.Close
  58.     Set rs = Nothing
  59.     Set db = Nothing
  60.  
  61. GoTo ThatsIt
  62. ErrorHandler:
  63.     Select Case Err.Number
  64.         Case 3021
  65.         Case Else
  66.             MsgBox "Problem with DataToBeSent()" & vbCrLf _
  67.                  & "Error " & Err.Number & ": " & Err.Description
  68.     End Select
  69. ThatsIt:
  70.     If Not rs Is Nothing Then Set rs = Nothing
  71.     If Not db Is Nothing Then Set db = Nothing
  72. End Sub
Notice Lines 11-15 then 37-50.

Hopefully this will get you closer to where you need to be.

7 1092
twinnyfo
3,653 Expert Mod 2GB
hrprabhu,

I was unable to test this, as I can't download your tables. However, try this:

Expand|Select|Wrap|Line Numbers
  1. Sub DataToBeSent()
  2. On Error GoTo ErrorHandler
  3.     Dim db As DAO.Database
  4.     Dim rs As DAO.Recordset
  5.     Dim s As String
  6.     Dim sSQL As String
  7.     Dim dDate As String
  8.     Dim I As Integer
  9.     Dim activeDir As String
  10.     Dim FileNum As Integer
  11.     Dim sCurrentState As String
  12.     Dim sCurrentTeam As String
  13.  
  14.     sCurrentState = ""
  15.     sCurrentTeam = ""
  16.  
  17.     activeDir = CurrentProject.Path
  18.  
  19.     sSQL = "SELECT AFL.StateName, " _
  20.         & "AFL.TeamName, " _
  21.         & "AFL.PlayerSurname, " _
  22.         & "AFL.EndOfSeason " _
  23.         & "FROM AFL " _
  24.         & "ORDER BY AFL.StateName, AFL.TeamName;"
  25.  
  26.  
  27.     Set db = CurrentDb
  28.     Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
  29.  
  30.     If Not rs.recodcount = 0 Then
  31.         With rs
  32.             .MoveFirst
  33.             s = "State Name" & vbTab & "Club Name" & _
  34.                 String(2, vbTab) & "End Of Season" & _
  35.                 String(2, vbTab) & "Player Name" & vbCrLf
  36.             Do Until .EOF
  37.                 s = s & _
  38.                     IIf(sCurrentState <> !StateName, _
  39.                         !StateName & vbCrLf, _
  40.                         String(2, vbTab)) & _
  41.                     IIf(sCurrentTeam <> !TeamName, _
  42.                         Left(!TeamName & Space(10), 10) & String(2, vbTab) & Left(!EndOfSeason & Space(10), 10) & vbCrLf, _
  43.                         String(6, vbTab)) & _
  44.                     !PlayerSurname & vbCrLf
  45.                 If sCurrentState <> !StateName Then
  46.                     sCurrentState = !StateName
  47.                 End If
  48.                 If sCurrentTeam <> !TeamName Then
  49.                     sCurrentTeam = !TeamName
  50.                 End If
  51.                 .MoveNext
  52.             Loop
  53.         End With
  54.         SendToFile activeDir & "\OutputGetting.txt", s
  55.     End If
  56.     rs.Close
  57.     db.Close
  58.     Set rs = Nothing
  59.     Set db = Nothing
  60.  
  61. GoTo ThatsIt
  62. ErrorHandler:
  63.     Select Case Err.Number
  64.         Case 3021
  65.         Case Else
  66.             MsgBox "Problem with DataToBeSent()" & vbCrLf _
  67.                  & "Error " & Err.Number & ": " & Err.Description
  68.     End Select
  69. ThatsIt:
  70.     If Not rs Is Nothing Then Set rs = Nothing
  71.     If Not db Is Nothing Then Set db = Nothing
  72. End Sub
Notice Lines 11-15 then 37-50.

Hopefully this will get you closer to where you need to be.
Sep 18 '14 #2
Hi Twinnyfo,
Thank you very much. It worked like a charm!
Sep 18 '14 #3
twinnyfo
3,653 Expert Mod 2GB
I'm glad I could be of assistance. Have a great day!
Sep 19 '14 #4
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
Sep 19 '14 #5
twinnyfo
3,653 Expert Mod 2GB
Now you're being sneaky!

Try This:

Expand|Select|Wrap|Line Numbers
  1. Sub DataToBeSent()
  2. On Error GoTo ErrorHandler
  3.     Dim db As DAO.Database
  4.     Dim rs As DAO.Recordset
  5.     Dim s As String
  6.     Dim sSQL As String
  7.     Dim dDate As String
  8.     Dim I As Integer
  9.     Dim activeDir As String
  10.     Dim FileNum As Integer
  11.     Dim sCurrentState As String
  12.     Dim sCurrentTeam As String
  13.     Dim iAlpha As Integer
  14.  
  15.     sCurrentState = ""
  16.     sCurrentTeam = ""
  17.     iAlpha = 65
  18.  
  19.     activeDir = CurrentProject.Path
  20.  
  21.     sSQL = "SELECT AFL.StateName, " _
  22.         & "AFL.TeamName, " _
  23.         & "AFL.PlayerSurname, " _
  24.         & "AFL.EndOfSeason " _
  25.         & "FROM AFL " _
  26.         & "ORDER BY AFL.StateName, AFL.TeamName;"
  27.  
  28.     Set db = CurrentDb
  29.     Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
  30.  
  31.     If Not rs.recodcount = 0 Then
  32.         With rs
  33.             .MoveFirst
  34.             s = "State Name" & vbTab & "Club Name" & _
  35.                 String(2, vbTab) & "End Of Season" & _
  36.                 String(2, vbTab) & "Player Name" & vbCrLf
  37.             Do Until .EOF
  38.                 s = s & _
  39.                     IIf(sCurrentState <> !StateName, _
  40.                         !StateName & vbCrLf, _
  41.                         String(2, vbTab)) & _
  42.                     IIf(sCurrentTeam <> !TeamName, _
  43.                         Left(!TeamName & Space(10), 10) & String(2, vbTab) & Left(!EndOfSeason & Space(10), 10) & vbCrLf, _
  44.                         String(6, vbTab)) & _
  45.                     Chr(iAlpha) & ". " & !PlayerSurname & vbCrLf
  46.                 iAlpha = iAlpha + 1
  47.                 If sCurrentState <> !StateName Then
  48.                     sCurrentState = !StateName
  49.                 End If
  50.                 If sCurrentTeam <> !TeamName Then
  51.                     sCurrentTeam = !TeamName
  52.                     iAlpha = 65
  53.                 End If
  54.                 .MoveNext
  55.             Loop
  56.         End With
  57.         SendToFile activeDir & "\OutputGetting.txt", s
  58.     End If
  59.     rs.Close
  60.     db.Close
  61.     Set rs = Nothing
  62.     Set db = Nothing
  63.  
  64. GoTo ThatsIt
  65. ErrorHandler:
  66.     Select Case Err.Number
  67.         Case 3021
  68.         Case Else
  69.             MsgBox "Problem with DataToBeSent()" & vbCrLf _
  70.                  & "Error " & Err.Number & ": " & Err.Description
  71.     End Select
  72. ThatsIt:
  73.     If Not rs Is Nothing Then Set rs = Nothing
  74.     If Not db Is Nothing Then Set db = Nothing
  75. End Sub
NB: Lines 13, 17, 45, 46, 52
Sep 19 '14 #6
Twinnyfo,
Thanks once again.
Sep 19 '14 #7
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.
Sep 20 '14 #8

Sign in to post your reply or Sign up for a free account.

Similar topics

5
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...
4
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.
8
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...
1
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. ...
5
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) ...
2
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,...
1
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...
3
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...
19
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...
5
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...
0
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...
0
by: ryjfgjl | last post by:
ExcelToDatabase: batch import excel into database automatically...
0
isladogs
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...
1
isladogs
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...
0
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...
0
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...
1
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)...
0
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...
0
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

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.