AirResourceSpec
asked on
Multidimensional Array of Custom Class
Hello All!
I'm confused by this legacy code anyhow, but I thought I had it figured out until I had to add a second dimension to my array.
Basically, I have the following code:
Dim column(1 To 50, 1 To 50) As colClass ' array of class object, to hold raw data
Do Until...
colCount = colCount + 1
Set column(colCount, intDayCount) = New colClass
Loop
intDayCount is set outside of the loop and works fine when intDayCount = 1, but when intDayCount = 2, I get an "Object variable or with block variable not set".
Any ideas? Previously this was a one dimensional array, is it possible to have a two dimensional array in this instance?
Thanks!
I'm confused by this legacy code anyhow, but I thought I had it figured out until I had to add a second dimension to my array.
Basically, I have the following code:
Dim column(1 To 50, 1 To 50) As colClass ' array of class object, to hold raw data
Do Until...
colCount = colCount + 1
Set column(colCount, intDayCount) = New colClass
Loop
intDayCount is set outside of the loop and works fine when intDayCount = 1, but when intDayCount = 2, I get an "Object variable or with block variable not set".
Any ideas? Previously this was a one dimensional array, is it possible to have a two dimensional array in this instance?
Thanks!
ASKER
Sure does! I guess I'll keep banging away on it... I'm so close!
ASKER
This is the line that is actually throwing the error later on in the code...
result = column(1, intDayCount).getValue(temp
Works fine when intDayCount = 1, but bombs when it gets to 2!?!? Is there something in colClass that may not be dimensioned correctly? I don't know what that would be or where to find it, but...
Any more ideas?
result = column(1, intDayCount).getValue(temp
Works fine when intDayCount = 1, but bombs when it gets to 2!?!? Is there something in colClass that may not be dimensioned correctly? I don't know what that would be or where to find it, but...
Any more ideas?
ASKER
Here's the colClass code:
Option Explicit
' Used For Assembling D File Information
' Each instance of this class represents a column of data, compete with header information and 24 hourly values
Private colName As String
Private chanNum As String
Private analogInput As String
Private unit As String
Private fullScale As String
Private highOutput As String
Private lowOutput As String
Private value(0 To 23) As String
Private flag(0 To 23) As String
Private Function fixw(strarg As String) As String ' Output Formatting function, fixes the width of a string field
On Error GoTo Err_fixw
Dim slen As Integer
slen = Len(strarg)
Do While True
If slen >= 9 Then
Exit Do
End If
strarg = " " & strarg ' pad string to 9 chars
slen = Len(strarg)
Loop
If slen = 10 Then ' pad to final width of 11
strarg = strarg & " "
Else ' this alternate case is assumed to be length of 9, from above. pad out to 11
strarg = strarg & " "
End If
fixw = strarg
Exit_fixw:
Exit Function
Err_fixw:
Call WriteToErrorLog("Error in fixw: " & Err.Number & " " & Err.Description, "ErrorHandler")
Resume Exit_fixw
End Function
' The following is a series of accessor functions which input or output various private variables
Friend Function getColName(newColName As String)
colName = Trim(newColName)
End Function
Friend Function putColName() As String
putColName = fixw(colName)
End Function
Friend Function getChanNum(newChanNum As String)
chanNum = Trim(newChanNum)
End Function
Friend Function putChanNum() As String
putChanNum = fixw(chanNum)
End Function
Friend Function getAnalogInput(newAnalogIn
analogInput = Trim(newAnalogInput)
End Function
Friend Function putAnalogInput() As String
putAnalogInput = fixw(analogInput)
End Function
Friend Function getUnit(newUnit As String)
unit = Trim(newUnit)
End Function
Friend Function putUnit() As String
putUnit = fixw(unit)
End Function
Friend Function getFullScale(newFullScale As String)
fullScale = Trim(newFullScale)
End Function
Friend Function putFullScale() As String
putFullScale = fixw(fullScale)
End Function
Friend Function getHighOutput(newHighOutpu
highOutput = Trim(newHighOutput)
End Function
Friend Function putHighOutput() As String
putHighOutput = fixw(highOutput)
End Function
Friend Function getLowOutput(newLowOutput As String)
lowOutput = Trim(newLowOutput)
End Function
Friend Function putLowOutput() As String
putLowOutput = fixw(lowOutput)
End Function
Friend Function getValue(newValue As String, index As Integer)
On Error GoTo Err_getValue
Dim tempstr As String
Dim tempLen As Integer
Dim flagChar As String
' look for error flags and get them if any are found
' the trick here is that the flags are appended to the right side of the actual values, and there is some testing required
' to distinguish wether or not a flag is present
tempstr = Trim(newValue)
' examine rightmost character
flagChar = Right(tempstr, 1)
' if its not a number or period, it must be a flag
If ((Not IsNumeric(flagChar)) And (Not (flagChar = "."))) Then
flag(index) = flagChar
tempLen = Len(tempstr)
tempstr = Left(tempstr, tempLen - 1)
End If
' look again, is there another flag character? there may be up to two
flagChar = Right(tempstr, 1)
If ((Not IsNumeric(flagChar)) And (Not (flagChar = "."))) Then
flag(index) = flagChar & flag(index) ' attach other flag char as head of string to other flag char
tempLen = Len(tempstr)
tempstr = Left(tempstr, tempLen - 1)
End If
value(index) = tempstr
Debug.Print "getvalue(" & index & ") = " & tempstr
Exit_getValue:
Exit Function
Err_getValue:
Call WriteToErrorLog("Error in getValue: " & Err.Number & " " & Err.Description, "ErrorHandler")
Resume Exit_getValue
End Function
Friend Function putvalue(index As Integer) As String ' output value and append flag if exists, all with the correct column format
On Error GoTo Err_putvalue
Dim tempstr As String
tempstr = fixw(value(index))
If Len(flag(index)) = 2 Then
tempstr = Left(tempstr, 9) & flag(index)
ElseIf Len(flag(index)) = 1 Then
tempstr = Left(tempstr, 9) & flag(index) & " "
End If
putvalue = tempstr
Debug.Print "putvalue(" & index & ") = " & tempstr
Exit_putvalue:
Exit Function
Err_putvalue:
Call WriteToErrorLog("Error in putvalue: " & Err.Number & " " & Err.Description, "ErrorHandler")
Resume Exit_putvalue
End Function
Option Explicit
' Used For Assembling D File Information
' Each instance of this class represents a column of data, compete with header information and 24 hourly values
Private colName As String
Private chanNum As String
Private analogInput As String
Private unit As String
Private fullScale As String
Private highOutput As String
Private lowOutput As String
Private value(0 To 23) As String
Private flag(0 To 23) As String
Private Function fixw(strarg As String) As String ' Output Formatting function, fixes the width of a string field
On Error GoTo Err_fixw
Dim slen As Integer
slen = Len(strarg)
Do While True
If slen >= 9 Then
Exit Do
End If
strarg = " " & strarg ' pad string to 9 chars
slen = Len(strarg)
Loop
If slen = 10 Then ' pad to final width of 11
strarg = strarg & " "
Else ' this alternate case is assumed to be length of 9, from above. pad out to 11
strarg = strarg & " "
End If
fixw = strarg
Exit_fixw:
Exit Function
Err_fixw:
Call WriteToErrorLog("Error in fixw: " & Err.Number & " " & Err.Description, "ErrorHandler")
Resume Exit_fixw
End Function
' The following is a series of accessor functions which input or output various private variables
Friend Function getColName(newColName As String)
colName = Trim(newColName)
End Function
Friend Function putColName() As String
putColName = fixw(colName)
End Function
Friend Function getChanNum(newChanNum As String)
chanNum = Trim(newChanNum)
End Function
Friend Function putChanNum() As String
putChanNum = fixw(chanNum)
End Function
Friend Function getAnalogInput(newAnalogIn
analogInput = Trim(newAnalogInput)
End Function
Friend Function putAnalogInput() As String
putAnalogInput = fixw(analogInput)
End Function
Friend Function getUnit(newUnit As String)
unit = Trim(newUnit)
End Function
Friend Function putUnit() As String
putUnit = fixw(unit)
End Function
Friend Function getFullScale(newFullScale As String)
fullScale = Trim(newFullScale)
End Function
Friend Function putFullScale() As String
putFullScale = fixw(fullScale)
End Function
Friend Function getHighOutput(newHighOutpu
highOutput = Trim(newHighOutput)
End Function
Friend Function putHighOutput() As String
putHighOutput = fixw(highOutput)
End Function
Friend Function getLowOutput(newLowOutput As String)
lowOutput = Trim(newLowOutput)
End Function
Friend Function putLowOutput() As String
putLowOutput = fixw(lowOutput)
End Function
Friend Function getValue(newValue As String, index As Integer)
On Error GoTo Err_getValue
Dim tempstr As String
Dim tempLen As Integer
Dim flagChar As String
' look for error flags and get them if any are found
' the trick here is that the flags are appended to the right side of the actual values, and there is some testing required
' to distinguish wether or not a flag is present
tempstr = Trim(newValue)
' examine rightmost character
flagChar = Right(tempstr, 1)
' if its not a number or period, it must be a flag
If ((Not IsNumeric(flagChar)) And (Not (flagChar = "."))) Then
flag(index) = flagChar
tempLen = Len(tempstr)
tempstr = Left(tempstr, tempLen - 1)
End If
' look again, is there another flag character? there may be up to two
flagChar = Right(tempstr, 1)
If ((Not IsNumeric(flagChar)) And (Not (flagChar = "."))) Then
flag(index) = flagChar & flag(index) ' attach other flag char as head of string to other flag char
tempLen = Len(tempstr)
tempstr = Left(tempstr, tempLen - 1)
End If
value(index) = tempstr
Debug.Print "getvalue(" & index & ") = " & tempstr
Exit_getValue:
Exit Function
Err_getValue:
Call WriteToErrorLog("Error in getValue: " & Err.Number & " " & Err.Description, "ErrorHandler")
Resume Exit_getValue
End Function
Friend Function putvalue(index As Integer) As String ' output value and append flag if exists, all with the correct column format
On Error GoTo Err_putvalue
Dim tempstr As String
tempstr = fixw(value(index))
If Len(flag(index)) = 2 Then
tempstr = Left(tempstr, 9) & flag(index)
ElseIf Len(flag(index)) = 1 Then
tempstr = Left(tempstr, 9) & flag(index) & " "
End If
putvalue = tempstr
Debug.Print "putvalue(" & index & ") = " & tempstr
Exit_putvalue:
Exit Function
Err_putvalue:
Call WriteToErrorLog("Error in putvalue: " & Err.Number & " " & Err.Description, "ErrorHandler")
Resume Exit_putvalue
End Function
In your class, comment out the error handler in your getValue() function and see if it flags a different line when the error occurs.
Friend Function getValue(newValue As String, index As Integer)
'On Error GoTo Err_getValue
Friend Function getValue(newValue As String, index As Integer)
'On Error GoTo Err_getValue
ASKER
Good idea! But...
It doesn't seem that getValue itself is the problem... when I turn off error handling, the
result = column(1, intDayCount).getValue(temp
line simply gets passed over and does not execute. I'm thinking it must be that intDayCount variable because when I try hard coding in a 1, everything works fine, but bombs when I hardcode a 2!?!? Here is the messy ugly routine that the above call comes from.
Please let me know if you can think of anything else to try!!!
Thx!
Public Function fmt8816() As Boolean
On Error GoTo Err_fmt8816 'commented out 20041006 WM
' this code uses a class to represent data columns (colClass.bas class module)
Dim siteid As String
Dim rfname As String
Dim dfname As String
Dim lfname As String
Dim spanfname As String
Dim errfname As String
Dim logfname As String
Dim newcol As colClass
Dim column(1 To 50, 1 To 50) As colClass ' array of class object, to hold raw data
Dim colCount As Integer ' cumulative count of data columns in R file
Dim blockCount As Integer ' how many blocks of columnar data? first one = 0
Dim relColCount As Integer ' relative column count of data column in a single block
Dim blnNewBlock As Integer 'added 20041006 WM
Dim yearnow As Integer ' current year i.e. year(date)
Dim result As Integer ' generic return value
Dim limit As Long
Dim errflag As Boolean
Dim n As Integer ' generic counters
Dim j As Integer
Dim i As Integer
Dim k As Integer 'added 20041005 WM
Dim cursorPos As Integer ' keeps track of cursor location while reading columns of raw data
Dim fline As String ' line of read file
Dim dfline As String ' line of write file (d-file)
Dim strtest As String
Dim tempstr As String
Dim fint As Integer
Dim strDate As String
Dim errmsg As String
Dim datestr As String
Dim rfnum As Integer
Dim dfnum As Integer
Dim intDayCount As Integer 'added 20041005 WM
Dim intMaxColumnCount As Integer 'added 20041005 WM
Dim dhdr(1 To 7) As String ' array holding d-file header rows
Dim strErrorMsg As String
fmt8816 = False
intDayCount = 1 'added 20041005 WM
intMaxColumnCount = 1 'added 20041005 WM
' put args values into local variables, for readability
siteid = args.siteid
rfname = args.rfname
dfname = args.dfname
lfname = args.lfname
spanfname = args.spanfname
errfname = args.errfname
logfname = args.logfname
yearnow = Year(DateValue(args.EventD
' fit siteid to standard 4-char width
Select Case Len(siteid)
Case 1
siteid = siteid & " "
Case 2
siteid = siteid & " "
Case 3
siteid = siteid & " "
End Select
'/////////////////////////
' D_FILE //////////////////////////
'/////////////////////////
' open files for read and write
rfnum = FreeFile()
If PathExists(PathFromFullPat
Open rfname For Input As #rfnum
Else
strErrorMsg = "Bad r file name and/or path"
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
'// check if this is a post-crosstalk file
Input #rfnum, fline
If InStr(1, fline, "nixtalk") > 0 Then
nixtalk = True
Else
nixtalk = False
End If
' look for start of actual data
' read through file until 'Name'
Do While True
Input #rfnum, fline
If InStr(fline, "Daily Av") > 0 Then
Exit Do
End If
Loop
For i = 1 To 3
Input #rfnum, fline
strtest = Left(fline, 4)
If strtest = "Name" Then
Exit For
End If
Next i
If strtest <> "Name" Then
strErrorMsg = "Data reformat failed while reading data block header - Names missing after reading first block."
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
'we have already read columnheader line (starts with 'name')
'ReDim column(1 To 2, 1 To 2) 'commented out 20041005 WM
' load fixed values for header
Set column(1, 1) = New colClass
column(1, 1).getColName ("Date")
column(1, 1).getChanNum ("Date")
column(1, 1).getAnalogInput ("Date")
column(1, 1).getUnit ("Date")
column(1, 1).getFullScale ("Date")
column(1, 1).getHighOutput ("Date")
column(1, 1).getLowOutput ("Date")
Set column(2, 1) = New colClass
column(2, 1).getColName ("Time")
column(2, 1).getChanNum ("Time")
column(2, 1).getAnalogInput ("Time")
column(2, 1).getUnit ("Time")
column(2, 1).getFullScale ("Time")
column(2, 1).getHighOutput ("Time")
column(2, 1).getLowOutput ("Time")
' reading block 0, already have two columns (date and time)
blockCount = 0
colCount = 2
READBLOCK:
cursorPos = 14 ' after date and time columns
Do While True
tempstr = "error" ' preload string with message, replaced if successful read
'get block of data
On Error Resume Next ' read next 13 spaces, eat error if not 13 columns to read
tempstr = Mid(fline, cursorPos, 13)
On Error GoTo Err_fmt8816 'commented out 20041006 WM
If (tempstr = "error") Or (Trim(tempstr) = "") Then ' if nothing successfully read, bug out
Exit Do
End If
'successful column read, add to number of known data columns
colCount = colCount + 1 ' increment column count
'ReDim Preserve column(1 To colCount, 1 To intDayCount)
Set column(colCount, intDayCount) = New colClass ' instantiate column object for found data column
column(colCount, intDayCount).getColName (tempstr) ' set column name
cursorPos = cursorPos + 14 ' move cursor over to next column space
Loop ' exited when no more columns found
If intDayCount > 1 Then 'added if condition 20040929 WM - if second day, parameter is already listed
For i = 1 To 7
Input #rfnum, fline
Next
End If
' at this point we have colCount columns . we need to get header info
' and 24 hours of data for each of them in the current block
' the column count refers to a list of data columns (1..n) starting with columns 1 and 2 as the date and time
'
' the date and time are read from block 0 and ignored for all other blocks. it is assumed that the date and time
' repeat for each block, as an esc8816 r file should only represent one day
'
' the list of columns is labeled for ease of writing, such that date and time columns in blocks > 0 are completely omitted.
' this means that if block zero had 7 columns (date + time + 5 data columns) and there was a block 1 with 5 columns,
' (date + time + 3 data columns), the date and time columns of block 1 would not be represented, and the 3 data columns
' would be labeled columns 8, 9 and 10, respectively.
' since the date and time columns (1 and 2) are snatched only for block zero as a special case, the default loop is to
' read from columns 3 to relColCount, where relColCount is the total number of columns in the current block.
' to understand how the relative column count is calculated, examine the following :::
' 1 2 3 4 5 6 7 block 0
' 8 9 10 11 12 block 1
' 13 14 15 16 17 etc. block 2
'
' given that relColCount = colCount - blockCount * 5
' you can see that the 3rd column (3,8,13) always has a relative column count of 3
' in this way, for i = 3 to relColCount always grabs the correct number of columns from a block.
' if assignments fail for any reason - goto jail!
If intDayCount = 1 Then 'added 20041001 WM
Input #rfnum, fline
relColCount = colCount - (blockCount * 5) ' number of data columns in current data block
cursorPos = 14 '
' get channel numbers
For n = 3 To relColCount ' ignore data and time columns in data blocks > 0
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getChanNum (tempstr)
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 14 '
Input #rfnum, fline
' get analog input numbers
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getAnalogInpu
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 14
Input #rfnum, fline
' get units
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getUnit (tempstr)
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 15
Input #rfnum, fline
' get full scale
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getFullScale (tempstr)
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 14
Input #rfnum, fline
' get high output
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getHighOutput
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 14
Input #rfnum, fline
' get low output
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getLowOutput (tempstr)
' advance cursor
cursorPos = cursorPos + 13
Next
' throw away line
Input #rfnum, fline
Else
relColCount = colCount - (blockCount * 5) ' number of data columns in current data block --- moved from here
End If
' get hourly data
For j = 0 To 23
cursorPos = 15
Input #rfnum, fline
If j <> Val(Mid(fline, 7, 2)) Then
strErrorMsg = "Hourly data line count failed."
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
If blockCount = 0 Then ' get date and time columns as a special case
Debug.Print "blockCount = " & blockCount & " - intDayCount = " & intDayCount
tempstr = Left(fline, 5)
datestr = tempstr & "/" & CStr(yearnow)
tempstr = Format(DateValue(datestr),
result = column(1, intDayCount).getValue(temp
tempstr = Mid(fline, 7, 5)
tempstr = Left(tempstr, 2) & Right(tempstr, 2)
result = column(2, intDayCount).getValue(temp
End If
' get data columns
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
'Debug.Print "column = " & n + (blockCount * 5) & " and intDayCount = " & intDayCount & " and j = " & j
result = column(n + (blockCount * 5), intDayCount).getValue(temp
' advance cursor
cursorPos = cursorPos + 13
Next
Next
' look for more data blocks
' read through file until "Daily Average" or "End of hourly data"
Do While True
Input #rfnum, fline
strtest = Left(fline, 13)
If InStr(fline, "$") > 0 Then 'added entire if statement 20040929 WM
intDayCount = intDayCount + 1
If intMaxColumnCount < colCount Then
intMaxColumnCount = colCount
End If
blockCount = 0 '??? 20041001 WM
blnNewBlock = True
colCount = 2
End If
If InStr(fline, "Daily Av") > 0 Then
For i = 1 To 3
Input #rfnum, fline
'this line has to be the channel name definition or fail
strtest = Left(fline, 4)
If strtest = "Name" Then
If blnNewBlock = False Then
blockCount = blockCount + 1
End If
'Debug.Print "intParamCount = " & intParamCount
blnNewBlock = False
GoTo READBLOCK ' start over with block n > 0...
End If
Next i
ElseIf strtest = "End of hourly" Then
Exit Do
End If
'will fail and goto datajail due to end of file
Loop
'/////////////////////////
'ready to write D file. Open it.
dfnum = FreeFile
If PathExists(PathFromFullPat
Open dfname For Output As #dfnum 'changed from input 20040325
Else
strErrorMsg = "Bad d file name and/or path"
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
' done getting data. we have colCount column objects,
' the first two being time and date, the others all being data
ReDim Columns(colCount, intDayCount)
'we can create the output files now
For j = 1 To 7
dhdr(j) = "SITE_ID LINE-ID DATE "
Next
' construct header lines
For j = 2 To intMaxColumnCount 'colCount changed 20041005 WM
dhdr(1) = dhdr(1) & column(j, 1).putChanNum
dhdr(2) = dhdr(2) & column(j, 1).putColName
dhdr(3) = dhdr(3) & column(j, 1).putUnit
dhdr(4) = dhdr(4) & column(j, 1).putAnalogInput
dhdr(5) = dhdr(5) & column(j, 1).putFullScale
dhdr(6) = dhdr(6) & column(j, 1).putHighOutput
dhdr(7) = dhdr(7) & column(j, 1).putLowOutput
Next
For j = 1 To 7
' write d/l file headers
Print #dfnum, dhdr(j)
Next
For k = 1 To intDayCount
For n = 0 To 23
' create d file output line
' make output strings
dfline = siteid & " " & siteid & " "
For j = 1 To intMaxColumnCount 'colCount changed 20041005 WM
'Debug.Print "j = " & j & " and k = " & k & " and n = " & n
dfline = dfline & column(j, k).putvalue(n)
Next
Print #dfnum, dfline ' write d file line
Next
Next
' if cals have been specified
If Not NoCal_Flag Then
'/////////////////////////
' L and Span Files //////////////////////////
'/////////////////////////
' call l_file manager
' call l_file()
If L_File_Manager(rfname, lfname) < 0 Then
' set errmsg
'fix WM 20040324
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
End If
fmt8816 = True
Call WriteToErrorLog("Reformat"
Exit_fmt8816:
Close #rfnum
Close #dfnum
Exit Function
Err_fmt8816:
fmt8816 = False
MsgBox "fmt8816 error" & vbCrLf & Err.Number & vbCrLf & Err.Description 'temp added 20041005 WM
If strErrorMsg <> "" Then
Call WriteToErrorLog(strErrorMs
Else
Call WriteToErrorLog("Error in fmt8816: " & Err.Number & " " & Err.Description, "ErrorHandler")
End If
Resume Exit_fmt8816
End Function
It doesn't seem that getValue itself is the problem... when I turn off error handling, the
result = column(1, intDayCount).getValue(temp
line simply gets passed over and does not execute. I'm thinking it must be that intDayCount variable because when I try hard coding in a 1, everything works fine, but bombs when I hardcode a 2!?!? Here is the messy ugly routine that the above call comes from.
Please let me know if you can think of anything else to try!!!
Thx!
Public Function fmt8816() As Boolean
On Error GoTo Err_fmt8816 'commented out 20041006 WM
' this code uses a class to represent data columns (colClass.bas class module)
Dim siteid As String
Dim rfname As String
Dim dfname As String
Dim lfname As String
Dim spanfname As String
Dim errfname As String
Dim logfname As String
Dim newcol As colClass
Dim column(1 To 50, 1 To 50) As colClass ' array of class object, to hold raw data
Dim colCount As Integer ' cumulative count of data columns in R file
Dim blockCount As Integer ' how many blocks of columnar data? first one = 0
Dim relColCount As Integer ' relative column count of data column in a single block
Dim blnNewBlock As Integer 'added 20041006 WM
Dim yearnow As Integer ' current year i.e. year(date)
Dim result As Integer ' generic return value
Dim limit As Long
Dim errflag As Boolean
Dim n As Integer ' generic counters
Dim j As Integer
Dim i As Integer
Dim k As Integer 'added 20041005 WM
Dim cursorPos As Integer ' keeps track of cursor location while reading columns of raw data
Dim fline As String ' line of read file
Dim dfline As String ' line of write file (d-file)
Dim strtest As String
Dim tempstr As String
Dim fint As Integer
Dim strDate As String
Dim errmsg As String
Dim datestr As String
Dim rfnum As Integer
Dim dfnum As Integer
Dim intDayCount As Integer 'added 20041005 WM
Dim intMaxColumnCount As Integer 'added 20041005 WM
Dim dhdr(1 To 7) As String ' array holding d-file header rows
Dim strErrorMsg As String
fmt8816 = False
intDayCount = 1 'added 20041005 WM
intMaxColumnCount = 1 'added 20041005 WM
' put args values into local variables, for readability
siteid = args.siteid
rfname = args.rfname
dfname = args.dfname
lfname = args.lfname
spanfname = args.spanfname
errfname = args.errfname
logfname = args.logfname
yearnow = Year(DateValue(args.EventD
' fit siteid to standard 4-char width
Select Case Len(siteid)
Case 1
siteid = siteid & " "
Case 2
siteid = siteid & " "
Case 3
siteid = siteid & " "
End Select
'/////////////////////////
' D_FILE //////////////////////////
'/////////////////////////
' open files for read and write
rfnum = FreeFile()
If PathExists(PathFromFullPat
Open rfname For Input As #rfnum
Else
strErrorMsg = "Bad r file name and/or path"
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
'// check if this is a post-crosstalk file
Input #rfnum, fline
If InStr(1, fline, "nixtalk") > 0 Then
nixtalk = True
Else
nixtalk = False
End If
' look for start of actual data
' read through file until 'Name'
Do While True
Input #rfnum, fline
If InStr(fline, "Daily Av") > 0 Then
Exit Do
End If
Loop
For i = 1 To 3
Input #rfnum, fline
strtest = Left(fline, 4)
If strtest = "Name" Then
Exit For
End If
Next i
If strtest <> "Name" Then
strErrorMsg = "Data reformat failed while reading data block header - Names missing after reading first block."
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
'we have already read columnheader line (starts with 'name')
'ReDim column(1 To 2, 1 To 2) 'commented out 20041005 WM
' load fixed values for header
Set column(1, 1) = New colClass
column(1, 1).getColName ("Date")
column(1, 1).getChanNum ("Date")
column(1, 1).getAnalogInput ("Date")
column(1, 1).getUnit ("Date")
column(1, 1).getFullScale ("Date")
column(1, 1).getHighOutput ("Date")
column(1, 1).getLowOutput ("Date")
Set column(2, 1) = New colClass
column(2, 1).getColName ("Time")
column(2, 1).getChanNum ("Time")
column(2, 1).getAnalogInput ("Time")
column(2, 1).getUnit ("Time")
column(2, 1).getFullScale ("Time")
column(2, 1).getHighOutput ("Time")
column(2, 1).getLowOutput ("Time")
' reading block 0, already have two columns (date and time)
blockCount = 0
colCount = 2
READBLOCK:
cursorPos = 14 ' after date and time columns
Do While True
tempstr = "error" ' preload string with message, replaced if successful read
'get block of data
On Error Resume Next ' read next 13 spaces, eat error if not 13 columns to read
tempstr = Mid(fline, cursorPos, 13)
On Error GoTo Err_fmt8816 'commented out 20041006 WM
If (tempstr = "error") Or (Trim(tempstr) = "") Then ' if nothing successfully read, bug out
Exit Do
End If
'successful column read, add to number of known data columns
colCount = colCount + 1 ' increment column count
'ReDim Preserve column(1 To colCount, 1 To intDayCount)
Set column(colCount, intDayCount) = New colClass ' instantiate column object for found data column
column(colCount, intDayCount).getColName (tempstr) ' set column name
cursorPos = cursorPos + 14 ' move cursor over to next column space
Loop ' exited when no more columns found
If intDayCount > 1 Then 'added if condition 20040929 WM - if second day, parameter is already listed
For i = 1 To 7
Input #rfnum, fline
Next
End If
' at this point we have colCount columns . we need to get header info
' and 24 hours of data for each of them in the current block
' the column count refers to a list of data columns (1..n) starting with columns 1 and 2 as the date and time
'
' the date and time are read from block 0 and ignored for all other blocks. it is assumed that the date and time
' repeat for each block, as an esc8816 r file should only represent one day
'
' the list of columns is labeled for ease of writing, such that date and time columns in blocks > 0 are completely omitted.
' this means that if block zero had 7 columns (date + time + 5 data columns) and there was a block 1 with 5 columns,
' (date + time + 3 data columns), the date and time columns of block 1 would not be represented, and the 3 data columns
' would be labeled columns 8, 9 and 10, respectively.
' since the date and time columns (1 and 2) are snatched only for block zero as a special case, the default loop is to
' read from columns 3 to relColCount, where relColCount is the total number of columns in the current block.
' to understand how the relative column count is calculated, examine the following :::
' 1 2 3 4 5 6 7 block 0
' 8 9 10 11 12 block 1
' 13 14 15 16 17 etc. block 2
'
' given that relColCount = colCount - blockCount * 5
' you can see that the 3rd column (3,8,13) always has a relative column count of 3
' in this way, for i = 3 to relColCount always grabs the correct number of columns from a block.
' if assignments fail for any reason - goto jail!
If intDayCount = 1 Then 'added 20041001 WM
Input #rfnum, fline
relColCount = colCount - (blockCount * 5) ' number of data columns in current data block
cursorPos = 14 '
' get channel numbers
For n = 3 To relColCount ' ignore data and time columns in data blocks > 0
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getChanNum (tempstr)
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 14 '
Input #rfnum, fline
' get analog input numbers
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getAnalogInpu
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 14
Input #rfnum, fline
' get units
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getUnit (tempstr)
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 15
Input #rfnum, fline
' get full scale
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getFullScale (tempstr)
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 14
Input #rfnum, fline
' get high output
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getHighOutput
' advance cursor
cursorPos = cursorPos + 13
Next
cursorPos = 14
Input #rfnum, fline
' get low output
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
column(n + (blockCount * 5), intDayCount).getLowOutput (tempstr)
' advance cursor
cursorPos = cursorPos + 13
Next
' throw away line
Input #rfnum, fline
Else
relColCount = colCount - (blockCount * 5) ' number of data columns in current data block --- moved from here
End If
' get hourly data
For j = 0 To 23
cursorPos = 15
Input #rfnum, fline
If j <> Val(Mid(fline, 7, 2)) Then
strErrorMsg = "Hourly data line count failed."
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
If blockCount = 0 Then ' get date and time columns as a special case
Debug.Print "blockCount = " & blockCount & " - intDayCount = " & intDayCount
tempstr = Left(fline, 5)
datestr = tempstr & "/" & CStr(yearnow)
tempstr = Format(DateValue(datestr),
result = column(1, intDayCount).getValue(temp
tempstr = Mid(fline, 7, 5)
tempstr = Left(tempstr, 2) & Right(tempstr, 2)
result = column(2, intDayCount).getValue(temp
End If
' get data columns
For n = 3 To relColCount
tempstr = Mid(fline, cursorPos, 13)
'Debug.Print "column = " & n + (blockCount * 5) & " and intDayCount = " & intDayCount & " and j = " & j
result = column(n + (blockCount * 5), intDayCount).getValue(temp
' advance cursor
cursorPos = cursorPos + 13
Next
Next
' look for more data blocks
' read through file until "Daily Average" or "End of hourly data"
Do While True
Input #rfnum, fline
strtest = Left(fline, 13)
If InStr(fline, "$") > 0 Then 'added entire if statement 20040929 WM
intDayCount = intDayCount + 1
If intMaxColumnCount < colCount Then
intMaxColumnCount = colCount
End If
blockCount = 0 '??? 20041001 WM
blnNewBlock = True
colCount = 2
End If
If InStr(fline, "Daily Av") > 0 Then
For i = 1 To 3
Input #rfnum, fline
'this line has to be the channel name definition or fail
strtest = Left(fline, 4)
If strtest = "Name" Then
If blnNewBlock = False Then
blockCount = blockCount + 1
End If
'Debug.Print "intParamCount = " & intParamCount
blnNewBlock = False
GoTo READBLOCK ' start over with block n > 0...
End If
Next i
ElseIf strtest = "End of hourly" Then
Exit Do
End If
'will fail and goto datajail due to end of file
Loop
'/////////////////////////
'ready to write D file. Open it.
dfnum = FreeFile
If PathExists(PathFromFullPat
Open dfname For Output As #dfnum 'changed from input 20040325
Else
strErrorMsg = "Bad d file name and/or path"
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
' done getting data. we have colCount column objects,
' the first two being time and date, the others all being data
ReDim Columns(colCount, intDayCount)
'we can create the output files now
For j = 1 To 7
dhdr(j) = "SITE_ID LINE-ID DATE "
Next
' construct header lines
For j = 2 To intMaxColumnCount 'colCount changed 20041005 WM
dhdr(1) = dhdr(1) & column(j, 1).putChanNum
dhdr(2) = dhdr(2) & column(j, 1).putColName
dhdr(3) = dhdr(3) & column(j, 1).putUnit
dhdr(4) = dhdr(4) & column(j, 1).putAnalogInput
dhdr(5) = dhdr(5) & column(j, 1).putFullScale
dhdr(6) = dhdr(6) & column(j, 1).putHighOutput
dhdr(7) = dhdr(7) & column(j, 1).putLowOutput
Next
For j = 1 To 7
' write d/l file headers
Print #dfnum, dhdr(j)
Next
For k = 1 To intDayCount
For n = 0 To 23
' create d file output line
' make output strings
dfline = siteid & " " & siteid & " "
For j = 1 To intMaxColumnCount 'colCount changed 20041005 WM
'Debug.Print "j = " & j & " and k = " & k & " and n = " & n
dfline = dfline & column(j, k).putvalue(n)
Next
Print #dfnum, dfline ' write d file line
Next
Next
' if cals have been specified
If Not NoCal_Flag Then
'/////////////////////////
' L and Span Files //////////////////////////
'/////////////////////////
' call l_file manager
' call l_file()
If L_File_Manager(rfname, lfname) < 0 Then
' set errmsg
'fix WM 20040324
fmt8816 = False
Call WriteToErrorLog(strErrorMs
GoTo Exit_fmt8816
End If
End If
fmt8816 = True
Call WriteToErrorLog("Reformat"
Exit_fmt8816:
Close #rfnum
Close #dfnum
Exit Function
Err_fmt8816:
fmt8816 = False
MsgBox "fmt8816 error" & vbCrLf & Err.Number & vbCrLf & Err.Description 'temp added 20041005 WM
If strErrorMsg <> "" Then
Call WriteToErrorLog(strErrorMs
Else
Call WriteToErrorLog("Error in fmt8816: " & Err.Number & " " & Err.Description, "ErrorHandler")
End If
Resume Exit_fmt8816
End Function
I can't find the problem in the code (though it's a lot to look through).
Still looking...
~IM
Still looking...
~IM
ASKER
Thanks for your efforts... I really appreciate any ideas you can come up with!
Set up A LOT of break-points and "step through" it and you should be able to spot anything going wrong. Remove any type of error-handling first, of course.
ASKER
Got it! Turns out I wasn't instantiating colClass for every array element prior to assigning a value to it.
Idle_Mind - Thanks for all of your ideas and efforts!
Idle_Mind - Thanks for all of your ideas and efforts!
Glad you got it working. =)
~IM
~IM
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Option Explicit
Private column() As colClass
Private Sub Form_Load()
Dim x As Integer
Dim y As Integer
ReDim column(1 To 50, 1 To 50)
For x = LBound(column, 1) To UBound(column, 1)
For y = LBound(column, 2) To UBound(column, 2)
Set column(x, y) = New colClass
Next
Next
End Sub