wwboy
asked on
Problem in charging a bi_dim array
Kind all,
I am facing this problem when charging the ArrMyArray Array within a RS loop.
what happen is the following: lets say I have the following values x the 1 record:
(lets suppose for semplicity I have just 2 records)
DB_FIELD1 = "ccc"; DB_FIELD2 = "ff;cc"; RS!DB_FIELD3 = "nn;jj"
DB_FIELD1 = "cc"; DB_FIELD2 = "bb;gg"; RS!DB_FIELD3 = "xx;rr"
In this case the array gets loaded ok,
BUT if in the 2 record I have a thing as:
DB_FIELD1 = "cc"; DB_FIELD2 = "bb"; RS!DB_FIELD3 = "xx"
where for the fields DB_FIELD2 and RS!DB_FIELD3 I have a DIFFERENT number of elements separed by ";" - here just 1 - than the other - there 2 elements - I get a subscript out of range error when loading the array.
Any help is sooooo welcome!!
While Not RS.EOF
Set RS = DalBdg.ExecuteSelect()
str1 = CStr(RS!DB_FIELD1)
str2 = CStr(RS!DB_FIELD2)
str3 = CStr(RS!DB_FIELD3)
Arrstr1 = Split(str1, ";")
Arrstr2 = Split(str2, ";")
Arrstr3 = Split(str3, ";")
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer
arrCount = (UBound(Arrstr1) + 1) * (UBound(Arrstr2) + 1) * (UBound(Arrstr3) + 1)
ReDim Preserve ArrMyArray(arrCount, 3)
arrCount = 0
For counter1 = 0 To UBound(Arrstr1)
For counter2 = 0 To UBound(Arrstr2)
For counter3 = 0 To UBound(Arrstr3)
arrContesto_Utente(arrCoun t, 0) = Arrstr1(counter1)
arrContesto_Utente(arrCoun t, 1) = Arrstr2(counter2)
arrContesto_Utente(arrCoun t, 2) = Arrstr3(counter3)
arrCount = arrCount + 1
Next
Next
Next
RS.MoveNext
Wend
I am facing this problem when charging the ArrMyArray Array within a RS loop.
what happen is the following: lets say I have the following values x the 1 record:
(lets suppose for semplicity I have just 2 records)
DB_FIELD1 = "ccc"; DB_FIELD2 = "ff;cc"; RS!DB_FIELD3 = "nn;jj"
DB_FIELD1 = "cc"; DB_FIELD2 = "bb;gg"; RS!DB_FIELD3 = "xx;rr"
In this case the array gets loaded ok,
BUT if in the 2 record I have a thing as:
DB_FIELD1 = "cc"; DB_FIELD2 = "bb"; RS!DB_FIELD3 = "xx"
where for the fields DB_FIELD2 and RS!DB_FIELD3 I have a DIFFERENT number of elements separed by ";" - here just 1 - than the other - there 2 elements - I get a subscript out of range error when loading the array.
Any help is sooooo welcome!!
While Not RS.EOF
Set RS = DalBdg.ExecuteSelect()
str1 = CStr(RS!DB_FIELD1)
str2 = CStr(RS!DB_FIELD2)
str3 = CStr(RS!DB_FIELD3)
Arrstr1 = Split(str1, ";")
Arrstr2 = Split(str2, ";")
Arrstr3 = Split(str3, ";")
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer
arrCount = (UBound(Arrstr1) + 1) * (UBound(Arrstr2) + 1) * (UBound(Arrstr3) + 1)
ReDim Preserve ArrMyArray(arrCount, 3)
arrCount = 0
For counter1 = 0 To UBound(Arrstr1)
For counter2 = 0 To UBound(Arrstr2)
For counter3 = 0 To UBound(Arrstr3)
arrContesto_Utente(arrCoun
arrContesto_Utente(arrCoun
arrContesto_Utente(arrCoun
arrCount = arrCount + 1
Next
Next
Next
RS.MoveNext
Wend
Further:
arrCount = (UBound(Arrstr1) + 1) * (UBound(Arrstr2) + 1) * (UBound(Arrstr3) + 1)
ReDim Preserve ArrMyArray(3, arrCount)
arrCount = 0
For counter1 = 0 To UBound(Arrstr1)
For counter2 = 0 To UBound(Arrstr2)
For counter3 = 0 To UBound(Arrstr3)
'arrContesto_Utente(arrCou nt, 0)
= Arrstr1(counter1)
'Change to
arrContesto_Utente(0,arrCo unt)
= Arrstr1(counter1)
arrContesto_Utente(1,arrCo unt) = Arrstr2(counter2)
etc....
arrCount = (UBound(Arrstr1) + 1) * (UBound(Arrstr2) + 1) * (UBound(Arrstr3) + 1)
ReDim Preserve ArrMyArray(3, arrCount)
arrCount = 0
For counter1 = 0 To UBound(Arrstr1)
For counter2 = 0 To UBound(Arrstr2)
For counter3 = 0 To UBound(Arrstr3)
'arrContesto_Utente(arrCou
= Arrstr1(counter1)
'Change to
arrContesto_Utente(0,arrCo
= Arrstr1(counter1)
arrContesto_Utente(1,arrCo
etc....
Also suggest that you are looping with no purpose, as with each loop you are clearing you array without doing anything withit.
So if you want to load all values from all records you may need some changes:
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer
ReDim ArrMyArray(3, 0)
Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
str1 = CStr(RS!DB_FIELD1)
str2 = CStr(RS!DB_FIELD2)
str3 = CStr(RS!DB_FIELD3)
Arrstr1 = Split(str1, ";")
Arrstr2 = Split(str2, ";")
Arrstr3 = Split(str3, ";")
For counter1 = 0 To UBound(Arrstr1)
For counter2 = 0 To UBound(Arrstr2)
For counter3 = 0 To UBound(Arrstr3)
arrCount = arrCount + 1
if arrCount> Ubound(ArrMyArray,2) Then
Redim Preserve ArrMyArray(3, arrCount + 100)' +100 for speed
end if
ArrMyArray(0, arrCount) = Arrstr1(counter1)
ArrMyArray(1, arrCount) = Arrstr2(counter2)
ArrMyArray(2, arrCount) = Arrstr3(counter3)
Next
Next
Next
RS.MoveNext
Wend
' Now you have all in ArrMyArray
Redim Preserve ArrMyArray(3, arrCount)
Hope this helps......
So if you want to load all values from all records you may need some changes:
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer
ReDim ArrMyArray(3, 0)
Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
str1 = CStr(RS!DB_FIELD1)
str2 = CStr(RS!DB_FIELD2)
str3 = CStr(RS!DB_FIELD3)
Arrstr1 = Split(str1, ";")
Arrstr2 = Split(str2, ";")
Arrstr3 = Split(str3, ";")
For counter1 = 0 To UBound(Arrstr1)
For counter2 = 0 To UBound(Arrstr2)
For counter3 = 0 To UBound(Arrstr3)
arrCount = arrCount + 1
if arrCount> Ubound(ArrMyArray,2) Then
Redim Preserve ArrMyArray(3, arrCount + 100)' +100 for speed
end if
ArrMyArray(0, arrCount) = Arrstr1(counter1)
ArrMyArray(1, arrCount) = Arrstr2(counter2)
ArrMyArray(2, arrCount) = Arrstr3(counter3)
Next
Next
Next
RS.MoveNext
Wend
' Now you have all in ArrMyArray
Redim Preserve ArrMyArray(3, arrCount)
Hope this helps......
And now I see that you are adding str1 & str2 multiple times I suspect that this may not be required. Suggest the following:
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer
ReDim ArrMyArray(3, 0)
Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
Arrstr1 = Split(CStr(RS!DB_FIELD1), ";"):Gosub AddToArray
Arrstr1 = Split(CStr(RS!DB_FIELD2), ";"):Gosub AddToArray
Arrstr1 = Split(CStr(RS!DB_FIELD3), ";"):Gosub AddToArray
RS.MoveNext
Wend
' Now you have all in ArrMyArray
Redim Preserve ArrMyArray(3, arrCount)
etc......
AddToArray:
For counter1 = 0 To UBound(Arrstr1)
arrCount = arrCount + 1
if arrCount> Ubound(ArrMyArray,2) Then
Redim Preserve ArrMyArray(3, arrCount + 100)' + 100 or more for speed
end if
ArrMyArray(0, arrCount) = Arrstr1(counter1)
Next
Return
Hope this helps......
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer
ReDim ArrMyArray(3, 0)
Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
Arrstr1 = Split(CStr(RS!DB_FIELD1), ";"):Gosub AddToArray
Arrstr1 = Split(CStr(RS!DB_FIELD2), ";"):Gosub AddToArray
Arrstr1 = Split(CStr(RS!DB_FIELD3), ";"):Gosub AddToArray
RS.MoveNext
Wend
' Now you have all in ArrMyArray
Redim Preserve ArrMyArray(3, arrCount)
etc......
AddToArray:
For counter1 = 0 To UBound(Arrstr1)
arrCount = arrCount + 1
if arrCount> Ubound(ArrMyArray,2) Then
Redim Preserve ArrMyArray(3, arrCount + 100)' + 100 or more for speed
end if
ArrMyArray(0, arrCount) = Arrstr1(counter1)
Next
Return
Hope this helps......
Getting smaller but now too small:
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer
ReDim ArrMyArray(2, 0)
Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
px=0:Arrstr1 = Split(CStr(RS!DB_FIELD1), ";"):Gosub AddToArray
px=1:Arrstr1 = Split(CStr(RS!DB_FIELD2), ";"):Gosub AddToArray
px=2:Arrstr1 = Split(CStr(RS!DB_FIELD3), ";"):Gosub AddToArray
RS.MoveNext
Wend
' Now you have all in ArrMyArray
Redim Preserve ArrMyArray(3, arrCount)
etc......
AddToArray:
For counter1 = 0 To UBound(Arrstr1)
arrCount = arrCount + 1
if arrCount> Ubound(ArrMyArray,2) Then
Redim Preserve ArrMyArray(3, arrCount + 100)' + 100 or more for speed
end if
ArrMyArray(PX, arrCount) = Arrstr1(counter1)
Next
Return
I think you may be better to change the structure of the array, but I don't know what you need it for.
Like:
ReDim ArrMyArray(1, 0)
etc....
AddToArray:
For counter1 = 0 To UBound(Arrstr1)
arrCount = arrCount + 1
if arrCount> Ubound(ArrMyArray,2) Then
Redim Preserve ArrMyArray(1, arrCount + 100)' + 100 or more for speed
end if
ArrMyArray(0, arrCount) = PX
ArrMyArray(1, arrCount) = Arrstr1(counter1)
Next
Return
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer
ReDim ArrMyArray(2, 0)
Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
px=0:Arrstr1 = Split(CStr(RS!DB_FIELD1), ";"):Gosub AddToArray
px=1:Arrstr1 = Split(CStr(RS!DB_FIELD2), ";"):Gosub AddToArray
px=2:Arrstr1 = Split(CStr(RS!DB_FIELD3), ";"):Gosub AddToArray
RS.MoveNext
Wend
' Now you have all in ArrMyArray
Redim Preserve ArrMyArray(3, arrCount)
etc......
AddToArray:
For counter1 = 0 To UBound(Arrstr1)
arrCount = arrCount + 1
if arrCount> Ubound(ArrMyArray,2) Then
Redim Preserve ArrMyArray(3, arrCount + 100)' + 100 or more for speed
end if
ArrMyArray(PX, arrCount) = Arrstr1(counter1)
Next
Return
I think you may be better to change the structure of the array, but I don't know what you need it for.
Like:
ReDim ArrMyArray(1, 0)
etc....
AddToArray:
For counter1 = 0 To UBound(Arrstr1)
arrCount = arrCount + 1
if arrCount> Ubound(ArrMyArray,2) Then
Redim Preserve ArrMyArray(1, arrCount + 100)' + 100 or more for speed
end if
ArrMyArray(0, arrCount) = PX
ArrMyArray(1, arrCount) = Arrstr1(counter1)
Next
Return
ASKER
plz inthedark, try to correct this.
Plz don't send new code :)
While Not RSAuthCodes.EOF
Set RSTriplets = DalBdg.ExecuteSelect("BDG_ AUTORIZZAZ IONI", strFieldNsmes, _
"COD_AUTORIZZAZIONE = '" & RSAuthCodes!COD_AUTORIZZAZ IONE & "'", strCnstring, _
DBG_SEVERITYLOG, EnumEveServ, ErrorMessage, _
DBG_FILE_LOG, DBG_LOGMAXSIZE, DBG_DIRWORK)
'se ci sono stati errori nella ExecuteSelect esco
If ErrorMessage <> "" Then
ErrorMessage = ErrorMessage
Login = arrContesto_Utente
Exit Function
End If
'
' 'per ciascuna tripletta trovata vado a caricare il mio array bi-dim
' 'x comodità salvo in variabili locali
COD_ATTIVITA = CStr(RSTriplets!COD_ATTIVI TA)
VALORE_ATTIVITA = CStr(RSTriplets!VALORE_ATT IVITA)
ELENCO_CDR = CStr(RSTriplets!ELENCO_CDR )
ArrCOD_ATTIVITA = Split(COD_ATTIVITA, ";") 'ARRAY COD_ATTIVITA
ArrVALORE_ATTIVITA = Split(VALORE_ATTIVITA, ";") 'array VALORE_ATTIVITA
ArrELENCO_CDR = Split(ELENCO_CDR, ";") 'ARRAY ELENCO_CDR
'
'prodotto cartesiano
If counterX > 0 Then
arrCount = (UBound(arrContesto_Utente , 1) + ((UBound(ArrCOD_ATTIVITA) + 1) * (UBound(ArrVALORE_ATTIVITA ) + 1) * (UBound(ArrELENCO_CDR) + 1)))
Else
arrCount = 1 + (UBound(ArrCOD_ATTIVITA) + 1) * (UBound(ArrVALORE_ATTIVITA ) + 1) * (UBound(ArrELENCO_CDR) + 1)
End If
If counterX > 0 Then
arrIndex = UBound(arrContesto_Utente, 1) + 1
Else
arrIndex = 1
End If
ReDim Preserve arrContesto_Utente(arrCoun t, 3)
For counter1 = 0 To UBound(ArrCOD_ATTIVITA)
For counter2 = 0 To UBound(ArrVALORE_ATTIVITA)
For counter3 = 0 To UBound(ArrELENCO_CDR)
arrContesto_Utente(arrInde x, 0) = ArrCOD_ATTIVITA(counter1)
arrContesto_Utente(arrInde x, 1) = ArrVALORE_ATTIVITA(counter 2)
arrContesto_Utente(arrInde x, 2) = ArrELENCO_CDR(counter3)
arrIndex = arrIndex + 1
Next
Next
Next
counterX = counterX + 1
RSAuthCodes.MoveNext
Wend
Plz don't send new code :)
While Not RSAuthCodes.EOF
Set RSTriplets = DalBdg.ExecuteSelect("BDG_
"COD_AUTORIZZAZIONE = '" & RSAuthCodes!COD_AUTORIZZAZ
DBG_SEVERITYLOG, EnumEveServ, ErrorMessage, _
DBG_FILE_LOG, DBG_LOGMAXSIZE, DBG_DIRWORK)
'se ci sono stati errori nella ExecuteSelect esco
If ErrorMessage <> "" Then
ErrorMessage = ErrorMessage
Login = arrContesto_Utente
Exit Function
End If
'
' 'per ciascuna tripletta trovata vado a caricare il mio array bi-dim
' 'x comodità salvo in variabili locali
COD_ATTIVITA = CStr(RSTriplets!COD_ATTIVI
VALORE_ATTIVITA = CStr(RSTriplets!VALORE_ATT
ELENCO_CDR = CStr(RSTriplets!ELENCO_CDR
ArrCOD_ATTIVITA = Split(COD_ATTIVITA, ";") 'ARRAY COD_ATTIVITA
ArrVALORE_ATTIVITA = Split(VALORE_ATTIVITA, ";") 'array VALORE_ATTIVITA
ArrELENCO_CDR = Split(ELENCO_CDR, ";") 'ARRAY ELENCO_CDR
'
'prodotto cartesiano
If counterX > 0 Then
arrCount = (UBound(arrContesto_Utente
Else
arrCount = 1 + (UBound(ArrCOD_ATTIVITA) + 1) * (UBound(ArrVALORE_ATTIVITA
End If
If counterX > 0 Then
arrIndex = UBound(arrContesto_Utente,
Else
arrIndex = 1
End If
ReDim Preserve arrContesto_Utente(arrCoun
For counter1 = 0 To UBound(ArrCOD_ATTIVITA)
For counter2 = 0 To UBound(ArrVALORE_ATTIVITA)
For counter3 = 0 To UBound(ArrELENCO_CDR)
arrContesto_Utente(arrInde
arrContesto_Utente(arrInde
arrContesto_Utente(arrInde
arrIndex = arrIndex + 1
Next
Next
Next
counterX = counterX + 1
RSAuthCodes.MoveNext
Wend
ASKER
Please do just some close interventions! :)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
While Not RS.EOF ' this does not exists yet?
Set RS = DalBdg.ExecuteSelect() ' this would recreate the same data
Looks like you could be looping......
Also:
ReDim Preserve ArrMyArray(arrCount, 3) ' is not allowed
as you can only chanmge theouter most ubound in a multi-dimensional array.
Try changing your logical array meaning so that you can say:
ReDim Preserve ArrMyArray(3, ArrayCount)
This may not have resolved all of the problems....