Treeview

[Daniela]

Hi everyone,

I built a treeview form so It is dynamic.

I have a table like this:

https://www.accessforums.net/attachm...1&d=1326883315

I had never used this but I took the code from the net and I have created a form, that on the event "On Load" I have written the following code:

Option Compare Database
Option Explicit
Private varHash As Variant

Private Sub Form_Load()
On Error GoTo Error_Trap
Dim objNode As Node, strKey As String
Dim rst As DAO.Recordset, intKey As Integer
varHash = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
With TreeView0
.Nodes.Clear
Set rst = CurrentDb.OpenRecordset("qry_Menu")
If rst.RecordCount > 0 Then
While Not rst.EOF
intKey = rst.Fields("IDTree").Value
If rst.Fields("Parent") = 0 Then
Set objNode = .Nodes.Add(, , NumberToString(intKey), rst.Fields("Description"))
objNode.Expanded = True
Else
Set objNode = .Nodes.Add(NumberToString(rst.Fields("Parent")), tvwChild, NumberToString(intKey), rst.Fields("Description"))
End If
rst.MoveNext
Wend
End If
End With
rst.Close
Set rst = Nothing

Error_Exit:
Exit Sub

Error_Trap:
MsgBox ("Error Code:" & Err.Number & " Error Description:" & Err.Description)
Resume Error_Exit
End Sub

Private Sub TreeView0_NodeClick(ByVal selectedNode As Object)
On Error GoTo Error_Trap
Dim intIDTree As Integer
Dim strSql As String
intIDTree = StringToNumber(selectedNode.Key)
strSql = "Select * from tbl_tree"
strSql = strSql & " where IDTree=" & intIDTree


Error_Exit:
Exit Sub

Error_Trap:
MsgBox ("Error Code:" & Err.Number & " Error Description:" & Err.Description)
Resume Error_Exit
End Sub



Private Function StringToNumber(strIn As String) As Integer
On Error GoTo Error_Trap
Dim i, j As Integer
Dim strReturn As String
For i = 0 To Len(Trim(strIn)) - 1
For j = 0 To UBound(varHash) - 1
If varHash(j) = Left(Right(strIn, Len(strIn) - i), 1) Then
strReturn = strReturn & j
Exit For
End If
Next
Next
StringToNumber = CInt(strReturn)
Error_Exit:


Exit Function

Error_Trap:
MsgBox ("Error Code:" & Err.Number & " Error Description:" & Err.Description)
Resume Error_Exit
End Function

Private Function NumberToString(intKey As Integer) As String
On Error GoTo Error_Trap
Dim i As Integer, strReturn As String
For i = 0 To Len(Trim(intKey)) - 1
strReturn = strReturn & varHash(Left(Right(intKey, Len(intKey) - i), 1))
Next
NumberToString = strReturn
Error_Exit:
Exit Function

Error_Trap:
MsgBox ("Error Code:" & Err.Number & " Error Description:" & Err.Description)
Resume Error_Exit
End Function

Untill now, everithing was going well and the treeview was working just fine. The problem is that my tree table has grown and the IDTree is now over 99. And I am having a "Error Code:13 Error Description; Type Mismatch". I have tested the several MsgBox that I have and the error is on the Private Function NumberToString,
particularly on this code (I think):

For i = 0 To Len(Trim(intKey)) - 1
strReturn = strReturn & varHash(Left(Right(intKey, Len(intKey) - i), 1))
Next

Can anyone help me?
Thanks,
Daniela

[June7]

Have you step debugged? On exactly what line does the error occur? Somewhere in the For loop?

[Daniela]

Have you step debugged? On exactly what line does the error occur? Somewhere in the For loop?

The debug shows an error on the code line:

strReturn = strReturn & varHash(Left(Right(intKey, Len(intKey) - i), 1))

[June7]

Does it error on the first pass of the For Next or later? When you step debug, are variable values as expected?

[orange]

I was looking at this and doing some testing with the NumberToString part.

I have this

Function NumberToString(intKey As Integer) As String
On Error GoTo Error_Trap
Dim varHash As Variant
varHash = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
Dim i As Integer, strReturn As String
For i = 0 To Len(Trim(intKey)) - 1
Debug.Print "-----------"; i; intKey; Right(intKey, Len(intKey) - i)
'Debug.Print Left(Right(intKey, Len(intKey) - i), 1)
'Debug.Print i; varHash(Left(Right(intKey, Len(intKey) - i), 1))

strReturn = strReturn & varHash(Left(Right(intKey, Len(intKey) - i), 1))

Next
NumberToString = strReturn
Error_Exit:
Exit Function
Error_Trap:
MsgBox ("Error Code:" & Err.number & " Error Description:" & Err.Description & " I  is " & i)

Resume Error_Exit
End Function


Sub testN2S()
Dim k As Integer
   On Error GoTo testN2S_Error
For k = 0 To 102
 Debug.Print k; NumberToString(k)
 Next k
   On Error GoTo 0
   Exit Sub
testN2S_Error:
    MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure testN2S of Module AWF_Related"
End Sub

The routine is building a 2 char string. When it gets to 99 which has string JJ it then fails. Here is some of my test debug info from 95 up

95 JF
----------- 0 96 96
----------- 1 96 6
96 JG
----------- 0 97 97
----------- 1 97 7
97 JH
----------- 0 98 98
----------- 1 98 8
98 JI
----------- 0 99 99
----------- 1 99 9
99 JJ
----------- 0 100 00
----------- 1 100 0
----------- 2 100
100 <-------------error message here
----------- 0 101 01
----------- 1 101 1
----------- 2 101
101 <-------------error message here
----------- 0 102 02
----------- 1 102 2
----------- 2 102 <----stopped manually here

I think the issue is basic to the algorithm used to create the 2 char string.

Other things are calling. Hope this is useful.

[June7]

Knew it had to have something to do with hitting 99 limit!
What string should 100 produce - KA or BAA?

If you want BAA, this works.

Function NTS(intKey) As String
Dim varHash, i As Integer
varHash = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
For i = 1 To Len(Trim(intKey))
    NTS = NTS & varHash(Mid(intKey, i, 1))
Next
End Function

Consider this to handle values up to 999 if you need the strings to sequence same as the numbers:

Function NTS(Key) As String
Dim varHash, i As Integer
Key = Format(Key, "000")
varHash = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
For i = 1 To Len(Key)
    NTS = NTS & varHash(Mid(Key, i, 1))
Next
End Function

[orange]

I think the issue is that 99 produces JJ, and you'd need a different algorithm to above 99.

[orange]

I think June7 code will work for more than 999

Short test

Sub testN2S()
Dim k As Integer
On Error GoTo testN2S_Error
For k = 20000 To 32688
NTS (k)
Debug.Print k; NTS(k)
Next k

On Error GoTo 0
Exit Sub
testN2S_Error:
MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure testN2S of Module AWF_Related"
End Sub

32681 DCGIB
32682 DCGIC
32683 DCGID
32684 DCGIE
32685 DCGIF
32686 DCGIG
32687 DCGIH
32688 DCGII
32689 DCGIJ
32690 DCGJA
32691 DCGJB
32692 DCGJC
32693 DCGJD
32694 DCGJE
32695 DCGJF
32696 DCGJG
32697 DCGJH
32698 DCGJI
32699 DCGJJ
32700 DCHAA
32701 DCHAB
32702 DCHAC
32703 DCHAD
32704 DCHAE
32705 DCHAF
32706 DCHAG
32707 DCHAH
32708 DCHAI
32709 DCHAJ
32710 DCHBA
32711 DCHBB
32712 DCHBC
32713 DCHBD
32714 DCHBE
32715 DCHBF
32716 DCHBG
32717 DCHBH
32718 DCHBI
32719 DCHBJ
32720 DCHCA
32721 DCHCB
32722 DCHCC
32723 DCHCD
32724 DCHCE
32725 DCHCF
32726 DCHCG
32727 DCHCH
32728 DCHCI
32729 DCHCJ
32730 DCHDA
32731 DCHDB
32732 DCHDC
32733 DCHDD
32734 DCHDE
32735 DCHDF
32736 DCHDG
32737 DCHDH
32738 DCHDI
32739 DCHDJ
32740 DCHEA
32741 DCHEB
32742 DCHEC
32743 DCHED
32744 DCHEE
32745 DCHEF
32746 DCHEG
32747 DCHEH
32748 DCHEI
32749 DCHEJ
32750 DCHFA
32751 DCHFB
32752 DCHFC
32753 DCHFD
32754 DCHFE
32755 DCHFF
32756 DCHFG
32757 DCHFH
32758 DCHFI
32759 DCHFJ
32760 DCHGA
32761 DCHGB
32762 DCHGC
32763 DCHGD
32764 DCHGE

[June7]

Yes, the first version will work for any number, no limit. The second is intended to produce strings that will alpha sort in same sequence as the number. This requires the strings to be fixed length, hence the Format function for 3 characters which will produce:

AAA 0
AAB 1
AAC 2
.
.
.
ABJ 99
BAA 100
BAB 101

It will also process larger numbers, but past 999 the string length will be more than 3 characters so the alpha sort will be wrong. Would have to set the Format function argument for the largest possible number that will be processed and then should have code to handle if that limit exceeded (message to user).

[Daniela]

I was looking at this and doing some testing with the NumberToString part.

I have this

Function NumberToString(intKey As Integer) As String
On Error GoTo Error_Trap
Dim varHash As Variant
varHash = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
Dim i As Integer, strReturn As String
For i = 0 To Len(Trim(intKey)) - 1
Debug.Print "-----------"; i; intKey; Right(intKey, Len(intKey) - i)
'Debug.Print Left(Right(intKey, Len(intKey) - i), 1)
'Debug.Print i; varHash(Left(Right(intKey, Len(intKey) - i), 1))

strReturn = strReturn & varHash(Left(Right(intKey, Len(intKey) - i), 1))

Next
NumberToString = strReturn
Error_Exit:
Exit Function
Error_Trap:
MsgBox ("Error Code:" & Err.number & " Error Description:" & Err.Description & " I  is " & i)

Resume Error_Exit
End Function


Sub testN2S()
Dim k As Integer
   On Error GoTo testN2S_Error
For k = 0 To 102
 Debug.Print k; NumberToString(k)
 Next k
   On Error GoTo 0
   Exit Sub
testN2S_Error:
    MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure testN2S of Module AWF_Related"
End Sub

The routine is building a 2 char string. When it gets to 99 which has string JJ it then fails. Here is some of my test debug info from 95 up
I think the issue is basic to the algorithm used to create the 2 char string.

Other things are calling. Hope this is useful.

Hi Orange! Thank you for your reply! I think I understand what you're saying. I know that the problem is after 99, but I still don't understand how can I fix it. I'm sorry but I'm still a rookie in programming.

[Daniela]

Knew it had to have something to do with hitting 99 limit!
What string should 100 produce - KA or BAA?

If you want BAA, this works.

Function NTS(intKey) As String
Dim varHash, i As Integer
varHash = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
For i = 1 To Len(Trim(intKey))
    NTS = NTS & varHash(Mid(intKey, i, 1))
Next
End Function

Consider this to handle values up to 999 if you need the strings to sequence same as the numbers:

Function NTS(Key) As String
Dim varHash, i As Integer
Key = Format(Key, "000")
varHash = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
For i = 1 To Len(Key)
    NTS = NTS & varHash(Mid(Key, i, 1))
Next
End Function

Hi June,

I believe that what I want is BAA.
Where should I put this code? I'm still in the basics of programming!
Thank you for your help!

[June7]

Put it in place of your existing Private Function NumberToString

[Daniela]

Hi June,

I believe that what I want is BAA.
Where should I put this code? I'm still in the basics of programming!
Thank you for your help!

June7, thanks a lot! It worked just fine!