Visual Basic - Looping to next acct number

Author

Looping to next acct number

Barbara

2005-03-29, 3:55 pm

I am new at programming and I have been given the task to finish another
programmer's work.

We start with a text file that the code will format and place the text in
the correct fields but the code will only loop through the text file once
and finishes before the EOF. The following is my code:

Private Sub cmdOpenFile_Click()

Dim pstrDatabase As String
Dim ff As Integer
Dim pstrAcctNum As String, pdteHeaderDate As Date, pstrPatient As
String
Dim pdteCommentDate As Date, pstrComment As String
Dim pstrCommentDate As String
Dim pstrLineData As String, pstrCommentLine As String
Dim pintCounter As Integer

'-------------------------------------------------
'open a file for scripting
On Error Resume Next
'-------------------------------------------------
With cmdiag
.CancelError = True
.Filter = "All Files(*.*)|*.*"
.InitDir = App.Path
.ShowOpen
'-----------------------------------------
'get out if the user clicks cancel
'-----------------------------------------
If Err <> 0 Then
Exit Sub
Else
On Error GoTo ErrHandle
End If
End With

'---------------------------------------------------------
'build the database name
'---------------------------------------------------------
pstrDatabase = Left(cmdiag.fileName, Len(cmdiag.fileName) - 4) &
Format(Now, "mmddyyyy") & ".mdb"

'---------------------------------------------------------
'prompt the user to overwrite the database if there
'---------------------------------------------------------
If fsObj.FileExists(pstrDatabase) = True Then
If MsgBox(pstrDatabase & " already exists. Overwrite?", vbYesNo
+ vbQuestion, App.Title) = vbYes Then
fsObj.DeleteFile pstrDatabase
Pause 2
If CreateScriptDatabase(pstrDatabase) = False Then
GoTo ErrHandle
End If
End If
Else
If CreateScriptDatabase(pstrDatabase) = False Then
GoTo ErrHandle
End If
End If
MsgBox "database created"

ff = FreeFile
Open cmdiag.fileName For Input As ff
'====================================
'No data in the database yet
'====================================

mscScript.ScriptFile = pstrDatabase 'putting information from
file to database
Do Until EOF(ff)
Line Input #ff, pstrLineData
If Left(pstrLineData, 6) = "HEADER" Then
'---------------------------------------------------------
'header info
'---------------------------------------------------------
pstrAcctNum = Mid(pstrLineData, 7, 13)
mscScript.Status1 = pstrAcctNum
pdteHeaderDate = FormatDateTime(Mid(pstrLineData, 21,
10), vbShortDate)
pstrPatient = Mid(pstrLineData, 31, Len(pstrLineData))
ElseIf pstrLineData <> "" Then
'---------------------------------------------------------
'loop until end of note and append all the comment lines
'create 1 long string of all the comments
'---------------------------------------------------------
pstrCommentLine = ""
Do 'Putting comment in the
field.
pstrCommentLine = pstrCommentLine & pstrLineData
Line Input #ff, pstrLineData
Loop Until Left(pstrLineData, 8) = "END NOTE"
'cut off the first |
pstrCommentLine = Trim(pstrCommentLine)
pstrCommentLine = Right(pstrCommentLine,
Len(pstrCommentLine) - 2)

'------------------------------------------------------
'at this point pstrcommentline is 1 long string of all
'the comments and comment dates
'------------------------------------------------------
'save the header record
With mscScript
.ScriptRecordSource = "Insert into
tblHeader(H_AcctNum,HeaderDate,PatientNa
me,Scripted) values ('" & _
pstrAcctNum & "',#" & pdteHeaderDate & "#,'"
& pstrPatient & "',0)"
End With
pintCounter = 1
Do
pstrCommentDate = splitstring(pstrCommentLine,
pintCounter, "|")
If pstrCommentDate = "" Then GoTo CleanUp
pdteCommentDate = FormatDateTime(pstrCommentDate,
vbShortDate)
pstrComment = Replace(splitstring(pstrCommentLine,
pintCounter + 1, "|"), "'", "''")
With mscScript
.ScriptRecordSource = "Insert into
tblComment(C_Acctnum,CommentDate,Comment
) values ('" & _
pstrAcctNum & "',#" & pdteCommentDate &
"#,'" & pstrComment & "')"
End With
pintCounter = pintCounter + 2
Loop
End If
'loop to next H_AcctNum ( this is where it should go to the next
record and it ends. Please help. bjd)

Loop
Thank you in advance for any help you may provide. bjd

Duke

2005-03-29, 8:55 pm

I see 2 possible problem areas:
1. Make sure that the following Do/Loop from your
program is not taking you to the EOF
"Loop Until Left(pstrLineData, 8) = "END NOTE"

2. I consider the use of GoTo a recipe for disaster only
surpassed by a nuclear holacaust. Maybe it is a hangover
from my days of programming in Cobol where I discovered
that the use of Go To causes you to lose control of a sub
routine.
Rewrite your code without using GoTo and I bet you a cup of
coffee that it will work just fine

Duke

>-----Original Message-----
>I am new at programming and I have been given the task to
finish another
>programmer's work.
>
>We start with a text file that the code will format and
place the text in
>the correct fields but the code will only loop through the
text file once
>and finishes before the EOF. The following is my code:
>
>Private Sub cmdOpenFile_Click()
>
> Dim pstrDatabase As String
> Dim ff As Integer
> Dim pstrAcctNum As String, pdteHeaderDate As Date,
pstrPatient As
>String
> Dim pdteCommentDate As Date, pstrComment As String
> Dim pstrCommentDate As String
> Dim pstrLineData As String, pstrCommentLine As String
> Dim pintCounter As Integer
>
> '-------------------------------------------------
> 'open a file for scripting
> On Error Resume Next
> '-------------------------------------------------
> With cmdiag
> .CancelError = True
> .Filter = "All Files(*.*)|*.*"
> .InitDir = App.Path
> .ShowOpen
> '-----------------------------------------
> 'get out if the user clicks cancel
> '-----------------------------------------
> If Err <> 0 Then
> Exit Sub
> Else
> On Error GoTo ErrHandle
> End If
> End With
>
> '---------------------------------------------------------
> 'build the database name
> '---------------------------------------------------------
> pstrDatabase = Left(cmdiag.fileName,
Len(cmdiag.fileName) - 4) &
>Format(Now, "mmddyyyy") & ".mdb"
>
> '---------------------------------------------------------
> 'prompt the user to overwrite the database if there
> '---------------------------------------------------------
> If fsObj.FileExists(pstrDatabase) = True Then
> If MsgBox(pstrDatabase & " already exists.
Overwrite?", vbYesNo
>+ vbQuestion, App.Title) = vbYes Then
> fsObj.DeleteFile pstrDatabase
> Pause 2
> If CreateScriptDatabase(pstrDatabase) =
False Then
> GoTo ErrHandle
> End If
> End If
> Else
> If CreateScriptDatabase(pstrDatabase) = False Then
> GoTo ErrHandle
> End If
> End If
> MsgBox "database created"
>
> ff = FreeFile
> Open cmdiag.fileName For Input As ff
> '====================================
> 'No data in the database yet
> '====================================
>
> mscScript.ScriptFile = pstrDatabase 'putting
information from
>file to database
> Do Until EOF(ff)
> Line Input #ff, pstrLineData
> If Left(pstrLineData, 6) = "HEADER" Then
>
'---------------------------------------------------------
> 'header info
>
'---------------------------------------------------------
> pstrAcctNum = Mid(pstrLineData, 7, 13)
> mscScript.Status1 = pstrAcctNum
> pdteHeaderDate =
FormatDateTime(Mid(pstrLineData, 21,
>10), vbShortDate)
> pstrPatient = Mid(pstrLineData, 31,
Len(pstrLineData))
> ElseIf pstrLineData <> "" Then
>
'---------------------------------------------------------
> 'loop until end of note and append all the
comment lines
> 'create 1 long string of all the comments
>
'---------------------------------------------------------
> pstrCommentLine = ""
> Do 'Putting
comment in the
>field.
> pstrCommentLine = pstrCommentLine
& pstrLineData
> Line Input #ff, pstrLineData
> Loop Until Left(pstrLineData, 8) =
"END NOTE"
> 'cut off the first |
> pstrCommentLine = Trim(pstrCommentLine)
> pstrCommentLine = Right(pstrCommentLine,
>Len(pstrCommentLine) - 2)
>
>
'------------------------------------------------------
> 'at this point pstrcommentline is 1
long string of all
> 'the comments and comment dates
>
'------------------------------------------------------
> 'save the header record
> With mscScript
> .ScriptRecordSource = "Insert into
> tblHeader(H_AcctNum,HeaderDate,PatientNa
me,Scripted)
values ('" & _
> pstrAcctNum & "',#" &
pdteHeaderDate & "#,'"
>& pstrPatient & "',0)"
> End With
> pintCounter = 1
> Do
> pstrCommentDate =
splitstring(pstrCommentLine,
>pintCounter, "|")
> If pstrCommentDate = "" Then GoTo
CleanUp
> pdteCommentDate =
FormatDateTime(pstrCommentDate,
>vbShortDate)
> pstrComment =
Replace(splitstring(pstrCommentLine,[col
or=darkred]
>pintCounter + 1, "|"), "'", "''")
> With mscScript
> .ScriptRecordSource = "Insert into
> tblComment(C_Acctnum,CommentDate,Comment
) values ('" & _
> pstrAcctNum & "',#" &[/color]
pdteCommentDate &
>"#,'" & pstrComment & "')"
> End With
> pintCounter = pintCounter + 2
> Loop
> End If
> 'loop to next H_AcctNum ( this is where it
should go to the next
>record and it ends. Please help. bjd)
>
> Loop
>Thank you in advance for any help you may provide. bjd
>
>
>
>.
>

Sponsored Links