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