Public Sub VBClassesToVBAWrapperSample()
'See also:
' VBClassesToVBAWrapper Function
' VBUtilitiesSample Subroutine
Const strFn = "VBClassesToVBAWrapperSample"
Dim strInFiles As String
strInFiles = InputBox("Read Visual Basic 4.0 Classes: (Wildcards allowed; {Esc} cancels.)", strFn, "\Entisoft\Tools\*.Cls")
If Len(strInFiles) = 0 Then Exit Sub
Dim strOutFile As String
strOutFile = GetTempFileName(Null, strFn)
strOutFile = InputBox("Write VBA Module: (FILE WILL BE OVERWRITTEN; {Esc} cancels.)", strFn, strOutFile)
If Len(strOutFile) = 0 Then Exit Sub
Dim strVBAType As String
strVBAType = InputBox("Visual Basic for Applications type: (Access 1-2 is Type 1; Access 7 is Type 3; Excel 5 is Type 2; Excel 7 is Type 2; Project 4 is Type 2; Project 7 is Type 2; Visual Basic 1-3 is Type 1; Visual Basic 4 is Type 3; {Esc} cancels.)", strFn, "3")
If Len(strVBAType) = 0 Then Exit Sub
Dim strFlagPrefix As String
strFlagPrefix = InputBox("Prefix for Module Flags: ({Esc} cancels.)", strFn, "''EntisoftTools VBClassesToVBAWrapper")
If Len(strFlagPrefix) = 0 Then Exit Sub
Dim strModuleHeader As String
strModuleHeader = "Public est As New EntisoftTools10232.Application"
strModuleHeader = InputBox("Module header string: ({Esc} means blank string.)", strFn, strModuleHeader)
Dim strFunctionHeader As String
strFunctionHeader = InputBox("Function header string: ({Esc} means blank string.)", strFn, "")
Dim intWrapPropertyGet As Integer
Select Case MsgBox("Create wrapper functions for Property Get procedures?", vbQuestion + vbYesNoCancel + vbDefaultButton1, strFn)
Case vbYes
intWrapPropertyGet = True
Case vbNo
intWrapPropertyGet = False
Case vbCancel
Exit Sub
Case Else
Stop
End Select
Dim intShortenArgumentNames As Integer
Select Case MsgBox("Shorten argument names by removing leading lower-case characters (unless that leaves a reserved word)?", vbQuestion + vbYesNoCancel + vbDefaultButton2, strFn)
Case vbYes
intShortenArgumentNames = True
Case vbNo
intShortenArgumentNames = False
Case vbCancel
Exit Sub
Case Else
Stop
End Select
Dim intIssueWarnings As Integer
Select Case MsgBox("Issue warnings about certain old-style and/or somewhat ambiguous syntax?", vbQuestion + vbYesNoCancel + vbDefaultButton2, strFn)
Case vbYes
intIssueWarnings = True
Case vbNo
intIssueWarnings = False
Case vbCancel
Exit Sub
Case Else
Stop
End Select
Dim strVBAReservedWords As String
strVBAReservedWords = InputBox("VBA Reserved Words: ({Esc} means no reserved words!)", strFn, VBAReservedWords)
MsgBox "Return = " & VBClassesToVBAWrapper( _
vInFiles:=strInFiles, _
vOutFile:=strOutFile, _
vVBAType:=strVBAType, _
vFlagPrefix:=strFlagPrefix, _
vModuleHeader:=strModuleHeader, _
vFunctionHeader:=strFunctionHeader, _
vWrapPropertyGet:=intWrapPropertyGet, _
vShortenArgumentNames:=intShortenArgumentNames, _
vIssueWarnings:=intIssueWarnings, _
vVBAReservedWords:=strVBAReservedWords _
) & " (True means success; False means failure.)", vbInformation, strFn
End SubCopyright 1996-1999 Entisoft
Entisoft Tools is a trademark of Entisoft.