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

VB Classes To VBA Wrapper Sample Sub
VB Utilities Class

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.