<-- Previous || Up || Next -->

VB Modules To Class Module Sample Sub
VB Utilities Class

Public Sub VBModulesToClassModuleSample()

    'See also:
    '  VBModulesToClassModule Function
    '  VBUtilitiesSample Subroutine

    Const strFn = "VBModulesToClassModuleSample"

    Dim strInFiles As String
    strInFiles = InputBox("Read Visual Basic Modules: (Wildcards allowed; {Esc} cancels.)", strFn, "\Entisoft\Tools\*.Bas")
    If Len(strInFiles) = 0 Then Exit Sub

    Dim strOutFile As String
    strOutFile = GetTempFileName(Null, strFn)
    strOutFile = InputBox("Write VBA Class: (FILE WILL BE OVERWRITTEN; {Esc} cancels.)", strFn, strOutFile)
    If Len(strOutFile) = 0 Then Exit Sub

    Dim strConstSuffix As String
    strConstSuffix = InputBox("Suffix added to name of Property Get procedure for Constants: ({Esc} cancels.)", strFn, "C")
    If Len(strConstSuffix) = 0 Then Exit Sub

    Dim strClassHeader As String
    strClassHeader = _
          "VERSION 1.0 CLASS" & vbCrLf _
        & "BEGIN" & vbCrLf _
        & "  MultiUse = -1  'True" & vbCrLf _
        & "End" & vbCrLf _
        & "Attribute VB_Name = ""Library""" & vbCrLf _
        & "Attribute VB_Creatable = True" & vbCrLf _
        & "Attribute VB_Exposed = True" & vbCrLf _
        & "Attribute VB_Description = ""Entisoft Tools Object Library""" & vbCrLf _
        & "' Entisoft Tools Object Library" & vbCrLf _
        & "' Copyright " & Year(Date) & " Entisoft" & vbCrLf
    strClassHeader = InputBox("Class module header?", strFn, strClassHeader)
    If Len(strClassHeader) = 0 Then Exit Sub

    Dim intStripComments As Integer
    Select Case MsgBox("Remove Comments from the Visual Basic Code?", vbQuestion + vbYesNoCancel + vbDefaultButton2, strFn)
        Case vbYes
            intStripComments = True
        Case vbNo
            intStripComments = False
        Case vbCancel
            Exit Sub
        Case Else
            Stop
    End Select

    If intStripComments Then
        Dim intKeepFlagsAndCoprs As Integer
        Select Case MsgBox("Retain Comments containing flags and copyright notices?", vbQuestion + vbYesNoCancel + vbDefaultButton1, strFn)
            Case vbYes
                intKeepFlagsAndCoprs = True
            Case vbNo
                intKeepFlagsAndCoprs = False
            Case vbCancel
                Exit Sub
            Case Else
                Stop
        End Select
    End If

    MsgBox "Return = " & VBModulesToClassModule( _
        vInFiles:=strInFiles, _
        vOutFile:=strOutFile, _
        vConstSuffix:=strConstSuffix, _
        vClassHeader:=strClassHeader, _
        vStripComments:=intStripComments, _
        vKeepFlagsAndCoprs:=intKeepFlagsAndCoprs _
        ) & " (True means success; False means failure.)", vbInformation, strFn
End Sub

Copyright 1996-1999 Entisoft
Entisoft Tools is a trademark of Entisoft.