VBA, Store Variables from a text file into an Array

New_Alex
New_Alex used Ask the Experts™
on
[ColorGroup]
2=3
4=4
3=1
6=5
5=1
1=0
0=0

[FontGroup]
IndexFont=Times New Roman
IndexSize=34
IndexUnderline=True
IndexItalic=True
IndexBold=True
IndexCellColour=2
Box1=False


[MiscGroup]
Rapids=2
Cats=4
Docs=3
6=5
5=5
1=1
0=0

Open in new window


Lets say I have the above format in a settings.txt file (also attached). I am trying to find a way to read the file into a 2 dimensional Array of the Format:

MyArray(Group, Variable)

For example if I:

Msgbox MyArray("ColorGroup", "6") it will output "5".
Msgbox MyArray("FontGroup", "IndexFont") it will output "Times New Roman".

Thanks.
(Full Points will be given to the first valid answer instantly within 30minutes of post.)


settings.txt
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Robert SchuttSoftware Engineer

Commented:
Your extra limitations may put people off...

I don't think you can use strings as indices of an array in VBA normally. You could use a double layer of Scripting.Dictionary objects, but maybe you're better off using a standard function to read ini files. A good example can be found on: http://www.bygsoftware.com/Excel/VBA/ini_files.htm 

Author

Commented:
My Problem is that I need to put all variables of the .ini file into an array and not getting in one by one which is resource consuming.

Any ideas?
Robert SchuttSoftware Engineer

Commented:
sure how about this:

Option Explicit

Dim g_MyArray As New Scripting.Dictionary

Private Sub Workbook_Open()
    ReadIniFile "settings.txt"
    
    MsgBox MyArray("ColorGroup", "6")
End Sub

Function MyArray(g, k)
    MyArray = g_MyArray.Item(g & "/" & k)
End Function

Sub ReadIniFile(fn)

    g_MyArray.RemoveAll

    Dim fso As New Scripting.FileSystemObject
    Dim f As TextStream
    Set f = fso.OpenTextFile(ActiveWorkbook.Path & "/" & fn)
    Set fso = Nothing

    Dim txt, group, iPos, sKey, sVal
    While Not f.AtEndOfStream
        txt = Trim(f.ReadLine)
        If txt = "" Then
            group = ""
        ElseIf Left(txt, 1) = "[" And Right(txt, 1) = "]" Then
            group = Trim(Mid(txt, 2, Len(txt) - 2))
        ElseIf group <> "" Then
            iPos = InStr(txt, "=")
            If iPos > 1 Then
                sKey = Trim(Left(txt, iPos - 1))
                sVal = Trim(Mid(txt, iPos + 1))
                If sKey <> "" Then ' And sVal <> "" Then
                    g_MyArray.Add group & "/" & sKey, sVal
                End If
            End If
        End If
    Wend
    f.Close
    Set f = Nothing
End Sub

Open in new window

Angular Fundamentals

Learn the fundamentals of Angular 2, a JavaScript framework for developing dynamic single page applications.

Author

Commented:
Man thanks but,

Is it possible to avoid this "Dim g_MyArray As New Scripting.Dictionary"?

I wouldn't lilke to define new objects in my code...

Thanks...
Software Engineer
Commented:
yes, you could use CreateObject:

Option Explicit

Dim g_MyArray

Private Sub Workbook_Open()
    ReadIniFile "settings.txt"
    
    MsgBox MyArray("ColorGroup", "6")
End Sub

Function MyArray(g, k)
    MyArray = g_MyArray.Item(g & "/" & k)
End Function

Sub ReadIniFile(fn)

    If IsEmpty(g_MyArray) Then Set g_MyArray = CreateObject("Scripting.Dictionary") Else g_MyArray.RemoveAll

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim f
    Set f = fso.OpenTextFile(ActiveWorkbook.Path & "/" & fn)
    Set fso = Nothing

    Dim txt, group, iPos, sKey, sVal
    While Not f.AtEndOfStream
        txt = Trim(f.ReadLine)
        If txt = "" Then
            group = ""
        ElseIf Left(txt, 1) = "[" And Right(txt, 1) = "]" Then
            group = Trim(Mid(txt, 2, Len(txt) - 2))
        ElseIf group <> "" Then
            iPos = InStr(txt, "=")
            If iPos > 1 Then
                sKey = Trim(Left(txt, iPos - 1))
                sVal = Trim(Mid(txt, iPos + 1))
                If sKey <> "" Then ' And sVal <> "" Then
                    g_MyArray.Add group & "/" & sKey, sVal
                End If
            End If
        End If
    Wend
    f.Close
    Set f = Nothing
End Sub

Open in new window

Author

Commented:
Working !

As promised !

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial