Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

convert sql to vba string

Status
Not open for further replies.

vba317

Programmer
Mar 5, 2009
708
US
I have found a faq on this website FAQ705-6112 to convert an SQL string to workable vba.
I am getting an error 3265 Item not found in this collection.
I have set up a form called frmSQL1
On the form I have an input textbox called txtSQL
a command button called cmdSQL
code behind the command box
I have another text box on the form called txtVba
I am hoping that I can get the code once completed to output to this box
I have highlighted in blue where the error is happening. Is it possible I am missing a reference?

Any help is appreciated

Tom


Code:
Private Sub cmdSQL_Click()
Dim qDefName As String
Call convertSQLToStdStr(txtSQL)
End Sub

Code:
Public gpaSStoks()     'An array of substitution tokens
Public gpaSSputs()     'A matching array of replacements
Public Function stdStr(varNumOrString) As String
'see ssArrays 'trying to make string construction less than totally awkward
'pass a string to append to static string (direct abutment -- no space)
'pass any number (e.g. False) to reset the string
'Always returns existing string whatever the state
'anything in global array gpaSStoks will be replaced by the respective gpaSSputs content 'character "~" is always replaced by vbcrlf
'see ssArrays to set substitution arrays
'remember not to transfer control while string is under construction
    Static theString As String
    If VarType(varNumOrString) <> vbString Then
        stdStr = theString
        theString = ""
    Else
        On Error Resume Next
        x = Replace(varNumOrString, "~", vbCrLf)
        'return substitute
        'these from convertSQLToStdStr
        x = Replace(x, Chr(168), Chr(34))
        'quote substitute
        x = Replace(x, "`", "'")
        'apostrophe substitute
        On Error Resume Next
        For i = 0 To UBound(gpaSStoks)
            If Err <> 0 Then Exit For
            If Len(gpaSStoks(i)) > 0 Then
                x = Replace(x, gpaSStoks(i), gpaSSputs(i))
            End If
        Next i
        theString = theString & x
        stdStr = theString
    End If
End Function
Public Function ssArrays(findIt, Putit) As Integer
'set values into public arrays for stdStr substitution
'see stdStr or this won't make sense 'reset the arrays by passing both findit and putit as zero length ( "" )
    Dim i As Integer
    Dim done As Boolean
    Static once
    'On Error Resume Next
    'if ubound(gpaSStoks) then goto
    If Not once Then    '
        ReDim gpaSStoks(0)
        ReDim gpaSSputs(0)
    Else    'look to replace current findit with putit
        For i = 0 To UBound(gpaSStoks)
            If gpaSStoks(i) = findIt Then
                gpaSSputs(i) = Putit
                done = True
                Exit For
            End If
        Next i
    End If
    If Not done Then
        'didn't happen, insert both
        If once Then
            ReDim Preserve gpaSStoks(i)
            ReDim Preserve gpaSSputs(i)
        End If
        gpaSStoks(i) = CStr(findIt)
        gpaSSputs(i) = CStr(Putit)
    End If
    If (Len(findIt) = 0) And (Len(Putit) = 0) Then
        'erase 'command' none of the above mattered...
        ReDim gpaSStoks(0)
        ReDim gpaSSputs(0)
        once = False    'reset to reuse a(0) next time
    Else
        once = True
    End If
    ssArrays = UBound(gpaSStoks)
End Function

Public Function convertSQLToStdStr(qDefName As String)
'Convert the SQL from qdefName (default TEMP)
'to stdSTR function calls.
'Allows SQL to be fully tested and then literally
'cut and pasted into code from the immediate window
'See also functions stdStr and SSarrays
    Dim qD As QueryDef
    Dim dBs As Database
    Dim pH As String, qDn As String, qdSQL As String, sniP As String
    Dim pT As Integer, epT As Integer
    If IsMissing(qDefName) Then
        qDn = "temp"
    Else
        qDn = qDefName
    End If
    Set dBs = CurrentDb()
[Blue]    Set qD = dBs.QueryDefs(qDn) [/Blue]
    qdSQL = Replace(qD.SQL, vbCrLf, "~")
    Debug.Print "stdStr false   'reset"
    Do While epT < Len(qdSQL)
        pT = epT + 1
        epT = InStr(pT, qdSQL, "~")
        If epT = 0 Then
            epT = Len(qdSQL)
        End If
        sniP = pH & Mid(qdSQL, pT, epT - pT)
        'next 2 will be restored by stdSTR
        sniP = Replace(sniP, Chr(34), Chr(168))
        'Hide the Quote character from VBA
        sniP = Replace(sniP, "'", "`")
        'Hide the apostrophe from vba
        pH = "~"
        Debug.Print "stdStr " & Chr(34) & sniP & Chr(34)
    Loop
    Debug.Print "SQL = stdStr(False)   'fetch and reset"
End Function
 
You may either use this:
X = "blah blah " & _
"more blah"
or this:
X = "blah blah " _
& "more blah"

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top