Random problem in VBA macro

[Tobby84]

Hello,

i am creating a VBA macro which is called by an Outlook rule.

I am trying to insert 3 random quotes in an Outlook model where %Ligne1% get replaced
by a random quote picked in "c:\outlook\ligne1.txt" and so on.

I got the macro working,
but sometimes, instead of getting a quote replaced, i got a blank line.
Sometimes line1, sometimes line2.... sometimes line3, sometimes all lines working...
sometimes 2 are blanks => random problem.. for my random quote problem (randomception?)

Here is the full code:

Sub SendNew(Item As Outlook.MailItem)
Dim objMsg As MailItem
Set objMsg = Application.CreateItemFromTemplate("C:\outlook\modele.oft")
' Copy the original message subject
objMsg.Subject = "Re: " & Item.Subject
' Ligne 1 
Dim lines() As String
Dim numLines As Integer
numLines = 0

' Open the file for reading
Open "c:\outlook\ligne1.txt" For Input As #1

' Go over each line in the file and save it in the array + count it
Do Until EOF(1)
ReDim Preserve lines(numLines + 1)
Line Input #1, lines(numLines)
numLines = numLines + 1
Loop

Close #1

            ' Get the random line number
Dim randLine As Integer
randLine = Int(numLines * Rnd()) + 1

' Insert the random quote
objMsg.HTMLBody = Replace(objMsg.HTMLBody, "%Ligne1%", lines(randLine))
           

' Ligne 2 
Dim lines2() As String
Dim numLines2 As Integer
numLines2 = 0

' Open the file for reading
Open "c:\outlook\ligne2.txt" For Input As #2

' Go over each line in the file and save it in the array + count it
Do Until EOF(2)
ReDim Preserve lines2(numLines2 + 1)
Line Input #2, lines2(numLines2)
numLines2 = numLines2 + 1
Loop

Close #2

            ' Get the random line number
Dim randLine2 As Integer
randLine2 = Int(numLines2 * Rnd()) + 1

' Insert the random quote
objMsg.HTMLBody = Replace(objMsg.HTMLBody, "%Ligne2%", lines2(randLine2))
           


' Ligne 3 
Dim lines3() As String
Dim numLines3 As Integer
numLines3 = 0

' Open the file for reading
Open "c:\outlook\ligne3.txt" For Input As #3

' Go over each line in the file and save it in the array + count it
Do Until EOF(3)
ReDim Preserve lines3(numLines3 + 1)
Line Input #3, lines3(numLines3)
numLines3 = numLines3 + 1
Loop

Close #3

            ' Get the random line number
Dim randLine3 As Integer
randLine3 = Int(numLines3 * Rnd()) + 1

' Insert the random quote
objMsg.HTMLBody = Replace(objMsg.HTMLBody, "%Ligne3%", lines3(randLine3))
           

' use for testing
' objMsg.Send

objMsg.Display
End Sub

What i already done :
- Checked if my txt file had blank line. No blank lines.
- Placed some msgbox to see where can be the problem :
randLine are ok, numLines are ok.

- lines(randLine) seems to show blank line when it happens,
so the problem is more likely to be on the "lines" string.

I really don't understand what's going on

Thanks by advance for help

Tobby

 

[Michael Bauer]

The lines array is one item bigger than needed. That is, if the file contains three lines, the array has four elements.

This one should work, it dims the first element before the loop and adds another one only if there's more than one line:

redim lines(0) as string
numlines=-1
do...
  numlines=numlines+1
  if numlines>0 then redim preserve lines(numlines)
  ...
loop

The alternative would be to simply delete the last array item after the loop:

if numlines>0 then redim preserve lines(numlines-1)

 

[Michael Bauer]

BTW: If you have, say, hundreds of lines in the file, it's much faster to oversize the array, then cut it once when done as every call of Redim takes a lot of time.

For instance, if you don't know if the file has 100, or 200, or maybe 1,000 lines, but you know it's not more than 2,000, then I'd do it this way:

redim lines(3000) as string
numlines=0
do...
    ...
    numlines=numlines+1
loop
if numlines=0 then
   'file's empty
else
   numlines=numlines-1
   redim preserve lines(numlines)
endif

Also, once numlines represents the true size of the array, your way of getting the random value doesn't work anymore. The formular for it is:

Randomize 'always call this first else the 'random' order will always be the same
min=0
max=numlines
value=int((max-min+1) * rnd + min)

 

[Tobby84]

Hello,

thanks you Michael Bauer

while posting my problem i kept trying to find a solution

and modifying :

Do Until EOF(1)
ReDim Preserve lines(numLines + 1)
Input #1, lines(numLines)
numLines = numLines + 1
Loop

by this:

Do Until EOF(1)
numLines = numLines + 1
ReDim Preserve lines(numLines + 1)
Input #1, lines(numLines)
Loop

(moving the position of "numLines = numLines + 1" )

This modification made the vba macro working perfectly now.
Or i am wrong? i tested several times with 3 lines txt file, got all randomly
with no blank line anymore.

Thanks you for your solutions anyway,

Tobby

 

[Michael Bauer]

A simple test will show you're wrong: Place a breakpoint on the Do Until line (press f9), then run the code. The code will stop at the breakpoint, now you can easily follow the values of the variables: Place the cursor in the "lines" word, and press shift+f9. This will add the variable "lines" to the * window (I've no clue how it's called in english). Do the same with the numLines variable.

Now walk through the code execution step by step by pressing f8, and watch how the values of variables change. You'll see that the first text is not written to the first array item. And note, the first array item has the index 0, not 1.

 

[Tobby84]

Hello,
i don't understand because i played it like 15x times to test with three lines in the file ligne1.txt and so on.
and got the three possibilities. So the first text is written.

I have the c:\outlook\ligne1.txt
with
"quote 1"
"quote 2"
"quote 3"
inside.

And playing this little code for testing :

Sub thetest(Item As Outlook.MailItem)
Dim lines() As String
Dim numLines As Integer
numLines = 0
' Open the file for reading
Open "c:\outlook\ligne1.txt" For Input As #1

' Go over each line in the file and save it in the array + count it
Do Until EOF(1)
numLines = numLines + 1
ReDim Preserve lines(numLines + 1)
Input #1, lines(numLines)
Loop
'If numLines > 0 Then ReDim Preserve lines(numLines - 1)
Close #1
' Get the random line number
Dim randLine As Integer
randLine = Int((numLines * Rnd) + 1)
' Insert the random quote
MsgBox (lines(1))
MsgBox (lines(2))
MsgBox (lines(3))
MsgBox (lines(randLine))
End Sub

( pasted in ThisOutlookSession)

Got all the threeline + the random line

don't understand but it's working

 

[Michael Bauer]

Yep, it's working because the current code never reads lines(0), which still is empty.