Solved

Multidimensional Array of Custom Class

Posted on 2004-10-06
14
186 Views
Last Modified: 2008-02-01
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!
0
Comment
Question by:AirResourceSpec
14 Comments
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 12239335
It's working fine for me:

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
0
 
LVL 1

Author Comment

by:AirResourceSpec
ID: 12239587
Sure does!  I guess I'll keep banging away on it... I'm so close!
0
 
LVL 1

Author Comment

by:AirResourceSpec
ID: 12239661
This is the line that is actually throwing the error later on in the code...
result = column(1, intDayCount).getValue(tempstr, j)

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?
0
 
LVL 1

Author Comment

by:AirResourceSpec
ID: 12239676
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(newAnalogInput As String)
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(newHighOutput As String)
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
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 12240040
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
0
 
LVL 1

Author Comment

by:AirResourceSpec
ID: 12240746
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(tempstr, j)
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.EventDate))

' 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(PathFromFullPathName(rfname)) = True Then
  Open rfname For Input As #rfnum
Else
  strErrorMsg = "Bad r file name and/or path"
  fmt8816 = False
  Call WriteToErrorLog(strErrorMsg, "Error")
  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(strErrorMsg, "Error")
    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).getAnalogInput (tempstr)
        ' 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 (tempstr)
        ' 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(strErrorMsg, "Error")
      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), "mm/dd/yyyy")
        result = column(1, intDayCount).getValue(tempstr, j)  'here is prob...

        tempstr = Mid(fline, 7, 5)
        tempstr = Left(tempstr, 2) & Right(tempstr, 2)
        result = column(2, intDayCount).getValue(tempstr, j)

    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(tempstr, j)
        ' 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(PathFromFullPathName(dfname)) = True Then
  Open dfname For Output As #dfnum  'changed from input 20040325
Else
  strErrorMsg = "Bad d file name and/or path"
  fmt8816 = False
  Call WriteToErrorLog(strErrorMsg, "Error")
  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(strErrorMsg, "Error")
        GoTo Exit_fmt8816
    End If


End If

fmt8816 = True
Call WriteToErrorLog("Reformat", "Successful")

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(strErrorMsg, "Error")
  Else
    Call WriteToErrorLog("Error in fmt8816: " & Err.Number & " " & Err.Description, "ErrorHandler")
  End If
  Resume Exit_fmt8816

End Function
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 12241405
I can't find the problem in the code (though it's a lot to look through).

Still looking...

~IM
0
 
LVL 1

Author Comment

by:AirResourceSpec
ID: 12241670
Thanks for your efforts... I really appreciate any ideas you can come up with!
0
 
LVL 17

Expert Comment

by:zzzzzooc
ID: 12256523
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.
0
 
LVL 1

Author Comment

by:AirResourceSpec
ID: 12258386
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!
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 12259423
Glad you got it working.  =)

~IM
0
 

Accepted Solution

by:
modulo earned 0 total points
ID: 12663849
PAQed with points refunded (350)

modulo
Community Support Moderator
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now