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.