Re = Visual Basic 6.0 Programming

Please advise me whether there is(are) any mistake(s) in my programmes. Thanks


Option Explicit ' Force explicit variable declaration
Dim Location$
Dim GetNextLine As Boolean
Private dts_file As String
Private Sub ReadDTS(DbankFile$, InputFile$)

On Error Resume Next ' Defer error trapping
'Kill DbankFile$ + ".mdb"
On Error GoTo 0 ' Turn off error trapping

Dim fH As Long ' Declare variable
Dim Y As New dbTimeSeries
Dim pGroup As New dbGroup
Dim ss$, pg$, c&, gg$

fH = FreeFile()
dts_file = InputFile$
Open dts_file For Input Access Read As #fH
BeginTrans

pg$ = DbankFile$
pGroup.ParentGroup = pg$

Dim group$, group_desc$, amount$, j, FileDate$, StartDate$
Dim u
Do

'ss$ = "Ida"
Do
ss$ = GetALine(fH, u)
Loop Until (Trim$(ss$) = "$$""R0""," Or ss$ = "")
If ss$ = "" Then Exit Do
ss = GetALine(fH, u)
If ss$ = "" Then Exit Do
ss = GetALine(fH, u)
If ss$ = "" Then Exit Do
Dim series_name$, country$
series_name = u(0)
'country$ = Left(u(0), 2)
Do Until (ss$ = "$$""R1""," Or ss$ = "")
ss$ = GetALine(fH, u)
Loop
Dim Series_Title$, Nobs&, frq$
If ss$ = "" Then Exit Do
ss$ = GetALine(fH, u)
StartDate$ = u(0)
FileDate$ = u(1)
'Nobs = u(4)
frq$ = u(2)
If ss$ = "" Then Exit Do
If (UBound(u) - 1) >= 6 Then
Series_Title$ = u(6)
Else
ss$ = GetALine(fH, u)
Series_Title$ = u(0)
End If

Do Until (ss$ = "$$""D0""," Or ss$ = "")
ss$ = GetALine(fH, u)
Loop
If ss$ = "" Then Exit Do

Select Case UCase$(frq$)
Case "M"
Y.Frequency = "M"
Y.StartDate = (Year(StartDate$) * 12) + Month(StartDate)
'Case "Y"
'Y.Frequency = "A"
'Y.StartDate = StartDate$
'Case "Q"
'Y.Frequency = "Q"
'Y.StartDate = StartDate$
Case Else
MsgBox "Unhandled frequency"
End Select

Dim ic&
ic& = 0
Do
ss$ = GetALine(fH, u)
For j = 0 To (UBound(u) - 1)
amount$ = VBA.Replace(u(j), """NA""", "")
If Trim(amount$) <> "" Then
If InStr(amount$, "T0") = 0 Then
ic& = ic& + 1
If Trim$(amount) <> "NA" Then
Y.DataValue(ic&) = Val(amount$)
'If Not Y.IsValidObs(ic) Then
'Debug.Print ic& & " " & amount$
'End If
End If
End If
End If
Next
Loop Until ss$ = "$$""T0"","

c& = c& + 1
If ((c& > 0) And ((c& Mod 10) = 0)) Then
CommitTrans ' Commit all the changes made
Debug.Print Seek(fH) & ", " & Format(Now, "ddddd ttttt")
BeginTrans ' Start of main transaction
End If

'Dim uu$

'uu$ = "[" + Mid$(InputFile$, InStrRev(InputFile$, "\") + 1, -InStrRev(InputFile$, "\") + InStrRev(InputFile$, ".") - 1) + "]"

If InputFile$ = "\datastream macro\cpi_2.txt" Then

gg$ = " [CPI" & "]"
Call pGroup.Make(pg$ & gg$, "Consumer Prices")
End If

Y.Name = pg$ & gg$ & series_name$
If Y.Exists Then
Y.Read
End If

Dim grp$, amt$, sss$, ld$

grp$ = group$
amt$ = amount$

sss$ = FileDate$
ld$ = sss$

Y.DataSource = "Datastream, BNM"
Y.ConversionMethod = tsLast
'Y.Nobs = Y.LastValidIndex 'Compute the effective # of observations

If InputFile$ = "\datastream macro\cpi_2.txt" Then
Y.Title = Series_Title$
Y.Units = "Index"

End If

Y.Save
Y.ClearData

DoEvents

Loop While Not EOF(fH)

End_This:
Close #fH
CommitTrans
Exit Sub
End Sub
Private Function GetALine(FileNum As Long, u As Variant) As String
On Error GoTo GetALineError:
StartRead:
Dim s$
If Not EOF(FileNum) Then
Line Input #FileNum, s$
s$ = Trim$(s$)
If s$ = "" Then GoTo StartRead
Dim j
u = Split(s$, ",")
For j = 0 To UBound(u)
u(j) = VBA.Replace(u(j), """", "")
Next
GetALine = s$
Debug.Print s$
Else
GetALine = ""
End If
Exit Function
GetALineError:
If Err > 0 Then MsgBox "GetALine: " & Error(Err)
Exit Function
End Function
Private Sub Form_Load()
Dim db$
db$ = "c:\vbfeds\dtstream\cpi_1"

Call ReadDTS(db$, "\datastream macro\cpi_2.txt")

MsgBox "All Done.", vbInformation
End
End Sub