Inserting a Fixed Block of Text into a Procedure

[Paulo357]

Currently this Module works placing "Members scores for 22/05/2012 out of a possible 200.020 were:" before the scores.
I would like to add a post script after the scores " Open from 6pm" if anyone can help...

Function ScoreRankingTotal(ByVal dtRank As Date, ByVal boolRanked As Boolean, Optional intTop As Integer = 0) As String
Dim qdf As QueryDef
Dim rs As Recordset
 
Dim strRank As String

 
strRank = "Members scores for " & Format(dtRank, "dd/mm/yy") & "; out of a possible 200.020 were: "

Set qdf = CurrentDb.QueryDefs("20020")
qdf.Parameters("[View Date]") = dtRank
 
Set rs = qdf.OpenRecordset
Do While Not rs.EOF
    strRank = strRank & rs.Fields("Member") & " " & rs.Fields("Total") & "; "
    If rs.AbsolutePosition = intTop - 1 Then Exit Do
    rs.MoveNext
Loop

Set rs = Nothing
Set qdf = Nothing

ScoreRankingTotal = strRank

End Function

[Rabbit]

I have no idea what you're asking.

[TheSmileyCoder]

First off, a Module is what in VBA is used to store code. You can have a form module which is stored along with the form and bound to the form, or a seperate module, not attached to any form, but simply belonging to the application as a whole.

When you use the term Module incorrectly as you have done, you are seriously confusing the matter at hand.

Now to add any text to your string, you can modify line 23, with ONE of the following examples:

ScoreRankingTotal = strRank & vbnewline & "Open from 6pm"
ScoreRankingTotal = strRank & "Open from 6 pm"

[Paulo357]

Apologies for my limited understanding of the terminology. Line 22 is blank, right? so I added your line 1 there.. Closed and Saved however the result was unchanged, I got the same when I tried your suggestion line 2. Am I confusing 'modify' with 'add'

[Paulo357]

Sorry for not making it clear. This code acts on a Query to format up a list of members scores for the local newspaper. I have a block of common text I place in the beginning of each write up.
It is:
"Members scores for 22/05/2012 out of a possible 200.020 were:" The code produces a line that can be copied which reads ...
Members scores for 22/05/12; out of a possible 200.020 were: Rick Ruiterman 199.014; Paul Abbot 199.006; John Ball 196.014; Neil Brown 194.008; Irene Cameron 193.009; Tallulah Hedley 193.005; Bill Teddy 192.004; Jeremy Hedley 190.005; Des Connelly 189.004; Stuart Cameron 184.003; Ian Edwards 181.004; Julia Stevenson-Renwick 180.004; etc etc.
I was trying to add another block if text to the end of this saying "Open from 6pm" and needed help on writing this line of code and advise where to place it within the code sample provided above.

[TheSmileyCoder]

Sorry, I made a typo, it was meant to say line 23.

[ADezii]

Currently this Module works placing "Members scores for 22/05/2012 out of a possible 200.020 were:" before the scores.
I would like to add a post script after the scores " Open from 6pm" if anyone can help...

Function ScoreRankingTotal(ByVal dtRank As Date, ByVal boolRanked As Boolean, Optional intTop As Integer = 0) As String
Dim qdf As QueryDef
Dim rs As Recordset
 
Dim strRank As String

 
strRank = "Members scores for " & Format(dtRank, "dd/mm/yy") & "; out of a possible 200.020 were: "

Set qdf = CurrentDb.QueryDefs("20020")
qdf.Parameters("[View Date]") = dtRank
 
Set rs = qdf.OpenRecordset
Do While Not rs.EOF
    strRank = strRank & rs.Fields("Member") & " " & rs.Fields("Total") & "; "
    If rs.AbsolutePosition = intTop - 1 Then Exit Do
    rs.MoveNext
Loop

Set rs = Nothing
Set qdf = Nothing

ScoreRankingTotal = strRank

End Function

'************************ Code intentionally omitted ************************
Do While Not rs.EOF
  strRank = strRank & rs.Fields("Member") & " " & rs.Fields("Total") & "; "
    If rs.AbsolutePosition = intTop - 1 Then Exit Do
      rs.MoveNext
Loop

strRank = Left$(strRank, Len(strRank) - 1)  'Remove Trailing ';'

'Add a Blank Line, then desired Text
strRank = strRank & vbCrLf & vbCrLf & "Open after 6:00 P.M."
'************************ Code intentionally omitted ************************

[Paulo357]

Thanks SmileyCoder that worked

[Paulo357]

ADezzi
I see your suggesting removing the trailing ;

strRank = Left$(strRank, Len(strRank) - 1)  'Remove Trailing ';'

This did not work .. Iam still interested in getting that right if you can have a second look please

[NeoPa]

Paulo357:
This did not work - I am still interested in getting that right if you can have a second look please

You might want to start by explaining what didn't work in that case ;-) Something 'not working' is very little to go on.

Try this variation of ADezii's code :

'************************ Code intentionally omitted ************************
Do While Not rs.EOF
  strRank = strRank & "; " & rs!Member & " " & rs!Total
  If rs.AbsolutePosition = intTop - 1 Then Exit Do
  rs.MoveNext
Loop
 
strRank = Mid(strRank, 3)  'Remove extra '; '
 
'Add a Blank Line, then desired Text
strRank = strRank & vbCrLf & vbCrLf & "Open after 6:00 P.M."
'************************ Code intentionally omitted ************************

[Paulo357]

Thanks NeoPa. Sorry thought I was being succinct. the code ran but didnt add the last line "Open after 6:00pm". re your code that did remove the trailing ";" thanks. I had to change the last reference from StrRank to ScoreRankingTot al. But it adds a blank line between the scores ending [now without a ; but I see now I'll need a fullstop. any ideas?
all the code looks like this now

Function ScoreRankingTotal(ByVal dtRank As Date, ByVal boolRanked As Boolean, Optional intTop As Integer = 0) As String
Dim qdf As QueryDef
Dim rs As Recordset
 
Dim strRank As String

 
strRank = "Members scores for " & Format(dtRank, "dd/mm/yy") & "; out of a possible 200.020 were: "

Set qdf = CurrentDb.QueryDefs("20020")
qdf.Parameters("[View Date]") = dtRank
 
Set rs = qdf.OpenRecordset
Do While Not rs.EOF
     strRank = strRank & "; " & rs!Member & " " & rs!Total
  If rs.AbsolutePosition = intTop - 1 Then Exit Do
  rs.MoveNext
Loop
 
strRank = Mid(strRank, 3)  'Remove extra '; '
 
'Add a Blank Line, then desired Text
ScoreRankingTotal = strRank & vbCrLf & vbCrLf & "Open after 6:00 P.M."
End Function

I dont know if its related or not but the results is clipping off the first 2 letters of the start???
" mbers scores for 22/05/12; out of a possible 200.020 were"
should read... Members scores etc.. is that something your code has done or what?
Appreciate any help

Paul

[NeoPa]

Paul:
is that something your code has done or what?

Yes. I hadn't followed the whole sequence of the logic, but just ADezii's snippet.

Try instead :

Function ScoreRankingTotal(ByVal dtRank As Date, _
                           ByVal boolRanked As Boolean, _
                           Optional intTop As Integer = 0) As String
    Dim db As DAO.Database
    Dim strRank As String

    Set db = CurrentDb()
    With db.QueryDefs("20020")
        .Parameters("[View Date]") = dtRank
        With .OpenRecordset
            Do While Not .EOF
                strRank = strRank & "; " & !Member & " " & !Total
                If .AbsolutePosition = (intTop - 1) Then Exit Do
                Call .MoveNext
            Loop
        End With
    End With

    strRank = "Members scores for %D; out of a possible 200.020 were: " & _
              Mid(strRank, 3) & "%L%LOpen after 6:00 P.M."
    strRank = Replace(strRank, "%D", Format(dtRank, "dd/mm/yy"))
    ScoreRankingTotal = Replace(strRank, "%L", vbNewLine)
End Function

PS. Indenting is not, and should never be, randomly applied. It is used to indicate which code is within a logical block. Indenting lines differently from others of the same logical block makes code very hard to follow. If you are not interested in indenting in a logical manner (I recommend you do, but if you choose not to), then I suggest you avoid indenting lines at all, as it simply confuses the vast majority of us for whom indenting is a very important aid to understanding the intent of the coder.

[Paulo357]

Hi NeoPa
Thanks for the help...
I pasted your code into my module and it showed an error on line 22. That entire line was red. Ive never seen %L%LOpen and "%L" code in MS Access before I may not be running the appropriate References to handle it.. But Iam interested to give it a try as no one else is helping just now.
Thanks for pointing out the indenting thing.. I didn't know that and I will try to implement it as I often grab bit & pieces and plug them into my projects.

[NeoPa]

Try the code again. I'm sorry for the error, but line #22 was missing a closing parenthesis ")" (which has now been fixed).

"%L" is simply a string. %X markers are simply used in this code to mark a place in the string for non-literal values to be inserted (The function Replace() is found in the VBA library, so it's about as standard usage as you can get).

EG. Instead of using code-block A, I tend to use code-block B :

1. Dim strMsg As String
   
   strMsg = "The date today is :" & vbNewLine & _
            Format(Date(), "d mmmm yyyy") & vbNewLine & vbNewLine & _
            "Have a nice day!"
   Call MsgBox(strMsg)

2. Dim strMsg As String
   
   strMsg = "The date today is :%L%D%L%LHave a nice day!"
   strMsg = Replace(strMsg, "%L", vbNewLine)
   strMsg = Replace(strMsg, "%D", Format(Date(), "d mmmm yyyy"))
   Call MsgBox(strMsg)

You get the same result, but in block B you can see at a glance the type of string the coder is planning to produce. I use % simply as a matter of convenience. It's a visible character that doesn't appear too often in ordinary text. As you will see if you check out this most useful of string functions in the Help system (See Context-Sensitive Help), the replaced string (Parameter #2) can be any valid string. Typically I use % strings of some form, but it can also prove useful to handle strings that have not been prepared in any way.

EG. To get the name of a back-end Access database from a linked table ([tblX]), where the value of .Connect is, for instance, ";DATABASE=H:\D atabase\Data97. Mdb", you could use :

Dim strName As String
Dim dbVar As DAO.Database

Set dbVar = CurrentDb()
strName = Replace(dbVar.TableDefs("tblX").Connect, ";DATABASE=", "")
Call MsgBox(strName)

[Paulo357]

Ahh, thank you that helped a lot.
Ive been tinkering with trying to remove the new line between the scores and the postscript entry and including a full stop after the scores
Line 22

ScoreRankingTotal = Replace(strRank, "%L", ". ")

This is giving me two full stops
I cant find the correct way to get one full stop and a single space before the postscript
Any thoughts?
regards paul