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 SubCopyright 1996-1999 Entisoft
Entisoft Tools is a trademark of Entisoft.