VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "makeUDTtool"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit


Private Type Name
    Name As String
    UDTx As String
    optX As String
    
    code0_Dim As String
    code1_init As String
    code2_LetUDT As String
    code3_GetUDT As String
    code4_Putopt As String
    code5_Getopt As String
    code6_UbndGetopt As String
    code7_UbndLetopt As String
    
    code10_OnGoSub As String
    code11_msgboxPROP As String
    code12_msgboxSUB As String
End Type




'========== Initializer ==========
Public Sub Class_Initialize()


End Sub


Public Sub makeClass(ByVal newClassName As String, ParamArray user_type_names())

    Dim fullcode As String
    Dim retOBJ As Object

    If VBA.IsMissing(user_type_names) Then
        MsgBox ("UDT name(s) must be included in arguments")
        Exit Sub
    End If

    fullcode = makeCode(Array(user_type_names)(0))
    
    Call get_make_customOBJECT(retOBJ, newClassName, "Class", fullcode)

End Sub


Private Sub get_make_customOBJECT(ByRef retOBJECT As Object, _
                                      ByVal objName As String, _
                                      ByVal objType As String, _
                                      ByVal objCode As String)
                                      
    Dim myOBJ As Object
    
    If does_code_exist(objName, myOBJ) = True Then
        Set retOBJECT = myOBJ
        Exit Sub
    End If
    
    Set myOBJ = CreateNewObject(objName, objType, objCode)
    Set retOBJECT = myOBJ

End Sub


Private Function CreateNewObject(ByVal objName As String, ByVal objType As String, ByVal objCode As String) As Object

    Dim myOBJ As Object
    
    Dim i As Integer
    Dim line As Integer
    
    objType = VBA.UCase(objType)

    Select Case objType
        
        Case "MODULE"
            i = 1
        Case "CLASS"
            i = 2
        Case "FORM"
            i = 3
        
        Case Else
            MsgBox ("invalid object type input")
            Set CreateNewObject = Nothing
            Exit Function
    End Select
    
    Set myOBJ = ThisWorkbook.VBProject.VBComponents.Add(i)
    
    With myOBJ
        .Properties("Name") = objName
    End With
    
    
    With myOBJ.CodeModule
        line = .CountOfLines + 1
        .InsertLines line, objCode
    End With


    Set CreateNewObject = myOBJ

End Function




Private Function does_code_exist(ByVal ObjectName As String, ByRef resOBJ As Object) As Boolean

    Dim myCodeModule As Object

    
    For Each myCodeModule In ThisWorkbook.VBProject.VBComponents
        Do
            If myCodeModule.Name <> ObjectName Then Exit Do
            
            Set resOBJ = ThisWorkbook.VBProject.VBComponents.Item(ObjectName)
            
            does_code_exist = True
            Exit Function
        Loop While (False)
    Next

    does_code_exist = False

End Function



Private Function makeCode(user_type_names) As String

    Dim names() As Name
    
    Dim base_code As String
    Dim full_code As String
    
    Dim i As Integer
    Dim str As String
    
    ReDim names(UBound(user_type_names) + 1)
    
    For i = 1 To UBound(user_type_names) + 1
    With names(i)
        .Name = user_type_names(i - 1)
        .UDTx = "UDT" & CStr(i)
        .optX = "opt" & CStr(i)
        
        .code0_Dim = "Private " & .UDTx & "() As " & .Name
        
        .code1_init = "namUDT(i) = " & Chr(34) & .Name & Chr(34) & ": i = i + 1"
        
        .code2_LetUDT = "Public Property Let " & .Name & "(UDT() As " & .Name & ")" & vbCrLf & _
                        vbTab & .UDTx & " = UDT" & vbCrLf & _
                        vbTab & "selUDT = " & CStr(i) & vbCrLf & _
                        "End Property"
                        
        .code3_GetUDT = "Public Property Get " & .Name & "() As " & .Name & "()" & vbCrLf & _
                        vbTab & "Dim s As Integer: s = selUDT" & vbCrLf & _
                        vbTab & "selUDT = " & CStr(i) & vbCrLf & _
                        vbTab & "If UBound_UDT_ < 0 Then MsgBox (" & Chr(34) & "UDT(" & .Name & ") not availble" & Chr(34) & ")" & vbCrLf & _
                        vbTab & "selUDT = s" & vbCrLf & _
                        vbTab & .Name & " = " & .UDTx & vbCrLf & _
                        "End Property"
                        
        .code4_Putopt = .optX & ": Put #filenumber, recnumber, " & .UDTx & ": Return"
        
        .code5_Getopt = .optX & ": Get #filenumber, recnumber, " & .UDTx & ": Return"
        
        .code6_UbndGetopt = .optX & ": UBound_UDT_ = UBound(" & .UDTx & "): Return"
        
        .code7_UbndLetopt = .optX & ": ReDim " & .UDTx & "(arr_len): Return"


        names(0).code10_OnGoSub = names(0).code10_OnGoSub & .optX
        If i < UBound(names) Then names(0).code10_OnGoSub = names(0).code10_OnGoSub & ", "
    End With
    Next
    
    names(0).code10_OnGoSub = names(0).code10_OnGoSub & vbTab & "'<-- add additional types here"
    names(0).code10_OnGoSub = "On selUDT GoSub " & names(0).code10_OnGoSub
    names(0).code10_OnGoSub = names(0).code10_OnGoSub & vbCrLf
    names(0).code10_OnGoSub = names(0).code10_OnGoSub & "GoTo optFinished"
    
    str = "If selUDT = 0 Then MsgBox (" & Chr(34) & "UDT() is not set, cannot perform operation" & Chr(34) & "): "
    names(0).code11_msgboxPROP = str & "Exit Property"
    names(0).code12_msgboxSUB = str & "Exit Sub"
    
    full_code = ""
    full_code = full_code & getCODE0_declares(names)
    full_code = full_code & getCODE1_INIT(names)
    full_code = full_code & getCODE2_Propertys(names)
    full_code = full_code & getCODE3_myPUT(names)
    full_code = full_code & getCODE4_myGET(names)
    full_code = full_code & getCODE5_getUBOUND(names)
    full_code = full_code & getCODE6_letUBOUND(names)
    full_code = full_code & get_base_code

'
'    MsgBox (getCODE4_myGET(names))
'    MsgBox (getCODE5_getUBOUND(names))
'    MsgBox (getCODE6_letUBOUND(names))
'

    makeCode = full_code

End Function




Private Function getCODE0_declares(names() As Name) As String

    Dim i As Integer
    Dim str As String
    
    str = ""
    str = str & "" & vbCrLf
    str = str & "Option Explicit" & vbCrLf
    str = str & "" & vbCrLf
    
    For i = 1 To UBound(names)
    With names(i)
        str = str & .code0_Dim & vbCrLf
    End With
    Next

    str = str & "'<-- add additional types here" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "Private selUDT As Integer" & vbCrLf
    str = str & "Private namUDT() As String" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "Private currFileName As String" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "" & vbCrLf
    
    getCODE0_declares = str
End Function



Private Function getCODE1_INIT(names() As Name) As String

    Dim i As Integer
    Dim str As String
    
    str = ""
    str = str & "'========== Initializer ==========" & vbCrLf
    str = str & "Public Sub Class_Initialize()" & vbCrLf
    str = str & "    selUDT = 0" & vbCrLf
    str = str & "    " & vbCrLf
    str = str & "    Dim i As Integer: i = 1" & vbCrLf
    str = str & "    ReDim namUDT(" & CStr(UBound(names)) & ")" & vbCrLf
        
        
    For i = 1 To UBound(names)
    With names(i)
        str = str & "    " & .code1_init & vbCrLf
    End With
    Next

    str = str & "    '<-- add additional types here" & vbCrLf
        
    str = str & "    currFileName = " & Chr(34) & Chr(34) & vbCrLf
    str = str & "End Sub" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "" & vbCrLf
    
    getCODE1_INIT = str
End Function




Private Function getCODE2_Propertys(names() As Name) As String


    Dim i As Integer
    Dim str As String
    
    str = ""
    
    For i = 1 To UBound(names)
    With names(i)
        str = str & .code2_LetUDT & vbCrLf
        If i < UBound(names) Then _
            str = str & "'---------------" & vbCrLf
    End With
    Next
    str = str & "'<-- add additional types here" & vbCrLf
    str = str & vbCrLf
    str = str & vbCrLf
    
    '----------------------------
    
    For i = 1 To UBound(names)
    With names(i)
        str = str & .code3_GetUDT & vbCrLf
        If i < UBound(names) Then _
            str = str & "'---------------" & vbCrLf
    End With
    Next
    str = str & "'<-- add additional types here" & vbCrLf
    str = str & vbCrLf
    str = str & vbCrLf
    
    getCODE2_Propertys = str
End Function


Private Function getCODE3_myPUT(names() As Name) As String

    Dim i As Integer
    Dim str As String
    
    str = ""

    str = str & "Private Sub myPut(filenumber, Optional recnumber As Variant)" & vbCrLf
    str = str & "" & vbCrLf
    str = str & names(0).code12_msgboxSUB & vbCrLf
    str = str & "" & vbCrLf
    str = str & names(0).code10_OnGoSub & vbCrLf
    str = str & "" & vbCrLf
    
    For i = 1 To UBound(names)
    With names(i)
        str = str & .code4_Putopt & vbCrLf
    End With
    Next
    
    str = str & "'<-- add additional types here" & vbCrLf
    str = str & "optFinished:" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "End Sub" & vbCrLf
    str = str & vbCrLf
    str = str & vbCrLf
    
    getCODE3_myPUT = str

End Function



Private Function getCODE4_myGET(names() As Name) As String

    Dim i As Integer
    Dim str As String

    str = ""

    str = str & "Private Sub myGet(filenumber, Optional recnumber As Variant)" & vbCrLf
    str = str & "" & vbCrLf
    str = str & names(0).code12_msgboxSUB & vbCrLf
    str = str & "" & vbCrLf
    str = str & names(0).code10_OnGoSub & vbCrLf
    str = str & "" & vbCrLf

    For i = 1 To UBound(names)
    With names(i)
        str = str & .code5_Getopt & vbCrLf
    End With
    Next
    
    str = str & "'<-- add additional types here" & vbCrLf
    str = str & "optFinished:" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "End Sub" & vbCrLf
    str = str & vbCrLf
    str = str & vbCrLf
    
    getCODE4_myGET = str

End Function



Private Function getCODE5_getUBOUND(names() As Name) As String

    Dim i As Integer
    Dim str As String

    str = ""
    
    str = str & "Private Property Get UBound_UDT_() As Long" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "If selUDT = 0 Then UBound_UDT_ = -1: Exit Property" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "On Error GoTo -1" & vbCrLf
    str = str & "On Error GoTo UDT_NOT_SET" & vbCrLf
    str = str & "" & vbCrLf
    str = str & names(0).code10_OnGoSub & vbCrLf
    str = str & "" & vbCrLf

    For i = 1 To UBound(names)
    With names(i)
        str = str & .code6_UbndGetopt & vbCrLf
    End With
    Next
    
    str = str & "'<-- add additional types here" & vbCrLf
    str = str & "optFinished:" & vbCrLf
    str = str & "    On Error GoTo -1" & vbCrLf
    str = str & "    On Error GoTo 0" & vbCrLf
    str = str & "    Exit Property" & vbCrLf
    str = str & "    " & vbCrLf
    str = str & "UDT_NOT_SET:" & vbCrLf
    str = str & "    UBound_UDT_ = -1" & vbCrLf
    str = str & "    On Error GoTo -1" & vbCrLf
    str = str & "    On Error GoTo 0" & vbCrLf
    str = str & "    " & vbCrLf
    str = str & "End Property" & vbCrLf
    str = str & vbCrLf
    str = str & vbCrLf

    getCODE5_getUBOUND = str

End Function




Private Function getCODE6_letUBOUND(names() As Name) As String
    
    Dim i As Integer
    Dim str As String

    str = ""
    
    str = str & "Private Property Let UBound_UDT_(arr_len As Long)" & vbCrLf
    str = str & "" & vbCrLf
    str = str & names(0).code11_msgboxPROP & vbCrLf
    str = str & "" & vbCrLf
    str = str & names(0).code10_OnGoSub & vbCrLf
    str = str & "" & vbCrLf

    For i = 1 To UBound(names)
    With names(i)
        str = str & .code7_UbndLetopt & vbCrLf
    End With
    Next

    str = str & "'<-- add additional types here" & vbCrLf
    str = str & "optFinished:" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "End Property" & vbCrLf
    str = str & "" & vbCrLf
    str = str & "" & vbCrLf
    
    getCODE6_letUBOUND = str

End Function






Private Function get_base_code() As String

get_base_code = get_base_code & "'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" & vbCrLf
get_base_code = get_base_code & "'++++++++++ Everything below can stay the same                          ++++++++++++++++++++++++" & vbCrLf
get_base_code = get_base_code & "'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "Private Property Let Filepath(strFileName As String)" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "'If selUDT = 0 Then MsgBox (" & Chr(34) & "UDT() is not set, cannot perform operation" & Chr(34) & "): Exit Property" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "strFileName = VBA.Replace(strFileName, " & Chr(34) & ".txt" & Chr(34) & ", " & Chr(34) & "" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "Dim i As Integer" & vbCrLf
get_base_code = get_base_code & "For i = 1 To UBound(namUDT)" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "    If VBA.InStr(strFileName, namUDT(i)) <> 0 Then" & vbCrLf
get_base_code = get_base_code & "        selUDT = i" & vbCrLf
get_base_code = get_base_code & "        strFileName = VBA.Replace(strFileName, " & Chr(34) & "_" & Chr(34) & " & namUDT(i), " & Chr(34) & "" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "        strFileName = VBA.Replace(strFileName, namUDT(i), " & Chr(34) & "" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "    End If" & vbCrLf
get_base_code = get_base_code & "Next" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "If strFileName = " & Chr(34) & "" & Chr(34) & " Then Exit Property" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "currFileName = strFileName" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "End Property" & vbCrLf
get_base_code = get_base_code & "'----------------------" & vbCrLf
get_base_code = get_base_code & "Private Property Get Filepath() As String" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "If selUDT = 0 Then MsgBox (" & Chr(34) & "UDT() is not set, cannot perform operation" & Chr(34) & "): Exit Sub" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "If currFileName = " & Chr(34) & "" & Chr(34) & " Then currFileName = " & Chr(34) & "udt_array" & Chr(34) & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "Filepath = ThisWorkbook.Path & " & Chr(34) & "\" & Chr(34) & " & currFileName & " & Chr(34) & "_" & Chr(34) & " & namUDT(selUDT) & " & Chr(34) & ".txt" & Chr(34) & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "End Property" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "'Save UDT array to FilePath." & vbCrLf
get_base_code = get_base_code & "Public Sub SaveUDT(Optional FileName As String = " & Chr(34) & "" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    Dim i As Integer" & vbCrLf
get_base_code = get_base_code & "    Dim save_occured As Boolean" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    save_occured = False" & vbCrLf
get_base_code = get_base_code & "    Do" & vbCrLf
get_base_code = get_base_code & "        " & vbCrLf
get_base_code = get_base_code & "        For i = 1 To UBound(namUDT)" & vbCrLf
get_base_code = get_base_code & "            If InStr(FileName, namUDT(i)) <> 0 Then" & vbCrLf
get_base_code = get_base_code & "                privSaveUDT save_occured, FileName" & vbCrLf
get_base_code = get_base_code & "                Exit Do" & vbCrLf
get_base_code = get_base_code & "            End If" & vbCrLf
get_base_code = get_base_code & "        Next" & vbCrLf
get_base_code = get_base_code & "        " & vbCrLf
get_base_code = get_base_code & "        For i = 1 To UBound(namUDT)" & vbCrLf
get_base_code = get_base_code & "            privSaveUDT save_occured, FileName & namUDT(i)" & vbCrLf
get_base_code = get_base_code & "        Next" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    Loop While (False)" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "    If save_occured = False Then MsgBox (" & Chr(34) & "failed to save UDT" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "End Sub" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "'Save UDT array to FilePath." & vbCrLf
get_base_code = get_base_code & "Private Sub privSaveUDT(ByRef save_performed As Boolean, Optional FileName As String = " & Chr(34) & "" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "    'You can write a UDT array directly to a file using the Put # statement." & vbCrLf
get_base_code = get_base_code & "    'However, when loading them back from the file, we need to know how" & vbCrLf
get_base_code = get_base_code & "    'many items there were in the array, so we can re-dimension it appropriately." & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    'So we will write a short 6 byte header to the beginning of the file." & vbCrLf
get_base_code = get_base_code & "    'This will be a number telling us how many items were in the array." & vbCrLf
get_base_code = get_base_code & "    'Then we can ReDim() the array before loading it back from the file." & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    'The header will always be 6 bytes, so for 3 item arrays, the header would be " & Chr(34) & "000003" & Chr(34) & "" & vbCrLf
get_base_code = get_base_code & "    'This makes the max number of array items " & Chr(34) & "999999" & Chr(34) & " for this example." & vbCrLf
get_base_code = get_base_code & "    'You can easily modify the code to give you more." & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    Dim intFF As Integer 'File handle to use." & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    intFF = FreeFile 'Get available file handle." & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "    Filepath = FileName    '<-- set full filepath using name" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    If UBound_UDT_ < 0 Then Exit Sub '<-- check that UDT() is initialized" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    Open Filepath For Output As #1: Close #1    '<-- clear previous contents" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    Open Filepath For Binary Access Write As #intFF" & vbCrLf
get_base_code = get_base_code & "        Put #intFF, 1, BuildHeader(6)   'Write header." & vbCrLf
get_base_code = get_base_code & "        " & vbCrLf
get_base_code = get_base_code & "        myPut intFF, LOF(intFF) + 1     'Write UDT array." & vbCrLf
get_base_code = get_base_code & "        " & vbCrLf
get_base_code = get_base_code & "    Close #intFF" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    save_performed = True" & vbCrLf
get_base_code = get_base_code & "End Sub" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "'Pads a string with 0's until its x bytes long." & vbCrLf
get_base_code = get_base_code & "Private Function BuildHeader(ByVal Length As Long) As String" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "    BuildHeader = String$(Abs(Length - Len(CStr(UBound_UDT_))), " & Chr(34) & "0" & Chr(34) & ") & CStr(UBound_UDT_)" & vbCrLf
get_base_code = get_base_code & "End Function" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "'Load the file back into the UDT array (udtTest())." & vbCrLf
get_base_code = get_base_code & "Public Sub LoadUDT(Optional FileName As String = " & Chr(34) & "" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "    Dim i As Integer" & vbCrLf
get_base_code = get_base_code & "    Dim load_occured As Boolean" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    load_occured = False" & vbCrLf
get_base_code = get_base_code & "    Do" & vbCrLf
get_base_code = get_base_code & "        " & vbCrLf
get_base_code = get_base_code & "        For i = 1 To UBound(namUDT)" & vbCrLf
get_base_code = get_base_code & "            If InStr(FileName, namUDT(i)) <> 0 Then" & vbCrLf
get_base_code = get_base_code & "                privLoadUDT load_occured, FileName" & vbCrLf
get_base_code = get_base_code & "                Exit Do" & vbCrLf
get_base_code = get_base_code & "            End If" & vbCrLf
get_base_code = get_base_code & "        Next" & vbCrLf
get_base_code = get_base_code & "        " & vbCrLf
get_base_code = get_base_code & "        For i = 1 To UBound(namUDT)" & vbCrLf
get_base_code = get_base_code & "            privLoadUDT load_occured, FileName & namUDT(i)" & vbCrLf
get_base_code = get_base_code & "        Next" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    Loop While (False)" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "    If load_occured = False Then MsgBox (" & Chr(34) & "failed to load UDT" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "End Sub" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "'Load the file back into the UDT array (udtTest())." & vbCrLf
get_base_code = get_base_code & "Private Sub privLoadUDT(ByRef load_performed As Boolean, Optional FileName As String = " & Chr(34) & "" & Chr(34) & ")" & vbCrLf
get_base_code = get_base_code & "    'First thing we'll do is look at the 4 byte header we wrote to the file." & vbCrLf
get_base_code = get_base_code & "    'This will tell us how many items are in the array." & vbCrLf
get_base_code = get_base_code & "    'Then we can ReDim udtTest() to the correct dimensions." & vbCrLf
get_base_code = get_base_code & "    'Then we can use the Get # statement to dump the file right back into the UDT array." & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    Dim intFF As Integer, strHeader As String" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    intFF = FreeFile" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    Filepath = FileName    '<-- set full filepath using name" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    If VBA.Dir(Filepath) = " & Chr(34) & "" & Chr(34) & " Then Exit Sub  '<-- check if path exist" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    'Buffer strHeader to 6 bytes." & vbCrLf
get_base_code = get_base_code & "    strHeader = SPACE$(6)" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    'Open file in binary read mode." & vbCrLf
get_base_code = get_base_code & "    Open Filepath For Binary Access Read As #intFF" & vbCrLf
get_base_code = get_base_code & "        'Get 4 byte header." & vbCrLf
get_base_code = get_base_code & "        Get #intFF, 1, strHeader" & vbCrLf
get_base_code = get_base_code & "        " & vbCrLf
get_base_code = get_base_code & "        'Re-dimension the array." & vbCrLf
get_base_code = get_base_code & "        UBound_UDT_ = CLng(strHeader)" & vbCrLf
get_base_code = get_base_code & "        " & vbCrLf
get_base_code = get_base_code & "        'Dump the file back into the UDT." & vbCrLf
get_base_code = get_base_code & "        myGet intFF, 7" & vbCrLf
get_base_code = get_base_code & " " & vbCrLf
get_base_code = get_base_code & "    Close #intFF" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "    load_performed = True" & vbCrLf
get_base_code = get_base_code & "    " & vbCrLf
get_base_code = get_base_code & "End Sub" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "" & vbCrLf
get_base_code = get_base_code & "'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" & vbCrLf
get_base_code = get_base_code & "'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" & vbCrLf


End Function