Attribute VB_Name = "mdlFormatSQL_CVM"
Option Explicit
'
' SQL Select Formatter (does not do checking)
'
' Made by: Michael V. Ciurescu (CVMichael from vbforums.com)
'
' Version 1.0
'

Public Function FormatSQLSelect(ByVal SQLStr As String, Optional TabStr As String = vbTab) As String
    Dim K As Long, MultiSelect As Boolean, PrevPos As Long
    Dim RefMulti As New Collection
    
    SQLStr = ResetFormat(SQLStr)
    
    K = 1
    PrevPos = 0
    
    Do Until K >= Len(SQLStr)
        K = SeekString(SQLStr, K)
        
        If Mid$(SQLStr, K, 1) = ";" Then
            MultiSelect = True
            
            RefMulti.Add SQLFormatRecurse(Mid$(SQLStr, PrevPos + 1, K - PrevPos - 1), TabStr)
            
            PrevPos = K
        End If
        
        K = K + 1
    Loop
    
    If MultiSelect Then
        RefMulti.Add SQLFormatRecurse(Mid$(SQLStr, PrevPos + 1), TabStr)
        
        SQLStr = ""
        Do Until RefMulti.Count = 0
            If RefMulti.Count > 1 Then
                SQLStr = SQLStr & RefMulti(1) & ";" & vbNewLine & vbNewLine
            Else
                SQLStr = SQLStr & RefMulti(1)
            End If
            
            RefMulti.Remove 1
        Loop
    Else
        SQLStr = SQLFormatRecurse(SQLStr, TabStr)
    End If
    
    FormatSQLSelect = Replace(SQLStr, vbNewLine & TabStr, vbNewLine)
End Function

Private Function ResetFormat(ByVal SQLStr As String) As String
    Dim K As Long, Q As Long
    Const constKEYWORDS As String = "SELECT|DISTINCT|FROM|WHERE|HAVING|ORDER BY|GROUP BY|ON|IN|AS|JOIN|LEFT JOIN|INNER JOIN|RIGHT JOIN|OUTER JOIN|CROSS JOIN|BETWEEN|AND|OR|DESC|ASC|IIF|TRIM|CDate|CStr|CInt|Fix|Cos|Sin|Tan|MAX|MIN|NOT|LIKE|InStr|Count"
    Dim KeyWords() As String
    
    KeyWords = Split(constKEYWORDS, "|")
    
    SQLStr = " " & Trim(SQLStr) & " "
    
    K = 1
    Do Until K >= Len(SQLStr)
        K = SeekString(SQLStr, K)
        
        Q = K
        
        While Mid$(SQLStr, Q, 1) = Chr(10) Or Mid$(SQLStr, Q, 1) = Chr(13) Or Mid$(SQLStr, Q, 1) = vbTab
            Mid$(SQLStr, Q, 1) = " "
            Q = Q + 1
        Wend
        
        If Q <> K Then
            Q = Q - 1
            
            While Mid$(SQLStr, Q, 1) = " "
                Q = Q - 1
            Wend
            
            K = Q
        End If
        
        Do While Mid$(SQLStr, K, 1) = " " And Mid$(SQLStr, K + 1, 1) = " "
            SQLStr = Left$(SQLStr, K - 1) & Mid$(SQLStr, K + 1)
        Loop
        
        For Q = 0 To UBound(KeyWords)
            If UCase(Mid$(SQLStr, K)) Like UCase("[() ]" & KeyWords(Q) & "[() ]*") Then
                Mid$(SQLStr, K + 1, Len(KeyWords(Q))) = KeyWords(Q)
            End If
        Next Q
        
        K = K + 1
    Loop
    
    K = 1
    Do Until K >= Len(SQLStr)
        K = SeekString(SQLStr, K)
        
        If Mid$(SQLStr, K, 2) = "( " Then
            SQLStr = Left(SQLStr, K) & Mid$(SQLStr, K + 2)
        ElseIf Mid$(SQLStr, K, 2) = " )" Then
            SQLStr = Left(SQLStr, K - 1) & Mid$(SQLStr, K + 1)
        End If
        
        K = K + 1
    Loop
    
    ResetFormat = Trim(SQLStr)
    
    Exit Function
End Function

Private Function SeekString(SQLStr As String, ByVal K As Long) As Long
    If Mid(SQLStr, K, 1) = """" Then
        Do Until K >= Len(SQLStr)
            K = K + 1
            
            If Mid(SQLStr, K, 1) = """" Then Exit Do
        Loop
        
        K = K + 1
    End If
    
    If Mid(SQLStr, K, 1) = "'" Then
        Do Until K >= Len(SQLStr)
            K = K + 1
            
            If Mid(SQLStr, K, 1) = "'" Then Exit Do
        Loop
        
        K = K + 1
    End If
    
    If Mid(SQLStr, K, 1) = "[" Then
        Do Until K >= Len(SQLStr)
            K = K + 1
            
            If Mid(SQLStr, K, 1) = "]" Then Exit Do
        Loop
        
        K = K + 1
    End If
    
    SeekString = K
End Function

Private Function SQLFormatRecurse(ByVal SQLStr As String, TabStr As String) As String
    Dim K As Long, Q As Long, Q2 As Long, P As Long, lp As Long, SubSQL As String
    Dim LeftSQL As String, RightSQL As String
    
    K = 1
    Do Until K >= Len(SQLStr)
        K = SeekString(SQLStr, K)
        
        If Mid(SQLStr, K, 1) = "(" Then
            Q2 = 1
            K = K + 1
            
            Do Until K >= Len(SQLStr)
                K = SeekString(SQLStr, K)
                
                If Mid(SQLStr, K, 1) = "(" Then
                    Q2 = Q2 + 1
                ElseIf Mid(SQLStr, K, 1) = ")" Then
                    Q2 = Q2 - 1
                    
                    If Q2 = 0 Then Exit Do
                End If
                
                K = K + 1
            Loop
            
            K = K + 1
        End If
        
        If Q = 0 And Mid(SQLStr, K, 1) = "," Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & "," & vbNewLine & TabStr & Trim(Mid(SQLStr, K + 1))
            K = K + 2 + Len(TabStr)
            lp = K
        ElseIf Q = 0 And UCase(Mid(SQLStr, K - (IIf(K > 2, 1, 0)))) Like "[ )]FROM[( ]*" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Trim(Mid(SQLStr, K))
            lp = K
            
            Exit Do
        ElseIf Mid(SQLStr, K, 1) = "(" Then
            Q = Q + 1
        ElseIf Mid(SQLStr, K, 1) = ")" Then
            Q = Q - 1
        End If
        
        K = K + 1
    Loop
    
    Do
        P = InStrLike(K + 1, SQLStr, "[ )(]SELECT[( ]*", vbTextCompare) + 1
        
        If P > 1 Then
            If Mid(SQLStr, P - 1, 1) = "(" Then
                K = P
                Q = 0
                
                Do Until K >= Len(SQLStr)
                    If Q = 0 And Mid(SQLStr, K, 1) = ")" Then
                        K = K + 1
                        
                        Exit Do
                    ElseIf Mid(SQLStr, K, 1) = "(" Then
                        Q = Q + 1
                    ElseIf Mid(SQLStr, K, 1) = ")" Then
                        Q = Q - 1
                    End If
                    
                    K = K + 1
                Loop
                
                If K = Len(SQLStr) Then K = K + 2
                
                LeftSQL = Left(SQLStr, P - 1) & vbNewLine & TabStr
                SubSQL = Mid(SQLStr, P, (K - P) - 1)
                RightSQL = Mid(SQLStr, K - 1)
                
                SubSQL = SQLFormatRecurse(SubSQL, TabStr) & vbNewLine & TabStr
                If InStrLikeRev(LeftSQL, "[() ]AND[( ]*", , vbTextCompare) > 0 Or _
                        InStrLikeRev(LeftSQL, "[() ]OR[( ]*", , vbTextCompare) > 0 Or _
                        InStrLikeRev(LeftSQL, "[() ]WHERE[( ]*", , vbTextCompare) > 0 Or _
                        InStrLikeRev(LeftSQL, "[() ]FROM[( ]*", , vbTextCompare) > 0 Then
                    
                    SubSQL = TabStr & Replace(SubSQL, vbNewLine, vbNewLine & TabStr)
                End If
                
                K = Len(LeftSQL & SubSQL)
                SQLStr = LeftSQL & SubSQL & RightSQL
            End If
        End If
    Loop Until P <= 1
    
    Q = 0
    K = lp
    If K = 0 Then
        K = InStr(1, SQLStr, " FROM ", vbTextCompare)

        If K > 0 Then
            lp = K
            SQLStr = Trim(Left(SQLStr, K)) & vbNewLine & Trim(Mid(SQLStr, K + 1))
        Else
            SQLFormatRecurse = Replace(SQLStr, vbNewLine, vbNewLine & TabStr)
            Exit Function
        End If
    End If
    
    Do Until K >= Len(SQLStr)
        K = SeekString(SQLStr, K)
        
        If Mid(SQLStr, K, 1) = "{" Then
            Do Until K >= Len(SQLStr)
                K = K + 1
                
                If Mid(SQLStr, K, 1) = "}" Then Exit Do
            Loop
            
            K = K + 1
        End If
        
        If Q = 0 And UCase(Mid(SQLStr, K)) Like "WHERE *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & "WHERE " & Mid(SQLStr, K + 6)
            
            K = K + 8
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "INNER JOIN *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Mid(SQLStr, K)
            
            K = K + 2 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "LEFT JOIN *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Mid(SQLStr, K)
            
            K = K + 2 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "RIGHT JOIN *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Mid(SQLStr, K)
            
            K = K + 2 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "OUTER JOIN *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Mid(SQLStr, K)
            
            K = K + 2 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "CROSS JOIN *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Mid(SQLStr, K)
            
            K = K + 2 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "GROUP BY *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Mid(SQLStr, K)
            
            K = K + 2 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "ORDER BY *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Mid(SQLStr, K)
            
            K = K + 2 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "HAVING *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & Mid(SQLStr, K)
            
            K = K + 2 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "AND *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & TabStr & Mid(SQLStr, K)
            
            K = K + 3 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "OR *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & TabStr & Mid(SQLStr, K)
            
            K = K + 3 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like " ON *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & TabStr & Mid(SQLStr, K + 1)
            
            K = K + 4 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "[ )]NOT IN[( ]*" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & TabStr & Mid(SQLStr, K + 1)
            
            K = K + 4 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "[ )]IN[( ]*" And Not (UCase(Mid(SQLStr, K - 3)) Like "NOT IN[( ]*") Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & TabStr & Mid(SQLStr, K + 1)
            
            K = K + 4 + Len(TabStr)
        ElseIf Q = 0 And UCase(Mid(SQLStr, K)) Like "BETWEEN *" Then
            SQLStr = Trim(Left(SQLStr, K - 1)) & vbNewLine & TabStr & Mid(SQLStr, K)
            K = K + 3 + Len(TabStr)
            Q2 = InStr(K, SQLStr, "AND ", vbTextCompare) + 3
            If Q2 > 0 Then K = Q2
        ElseIf Mid(SQLStr, K, 1) = "(" Then
            Q = Q + 1
        ElseIf Mid(SQLStr, K, 1) = ")" Then
            Q = Q - 1
        End If
        
        K = K + 1
    Loop
    
    SQLFormatRecurse = Replace(SQLStr, vbNewLine, vbNewLine & TabStr)
End Function

Private Function InStrLike(ByVal Start As Long, ByVal String1 As String, ByVal String2 As String, Optional Compare As VbCompareMethod = vbBinaryCompare) As Long
    Dim K As Long
    
    If Start < 1 Then Start = 1
    If Start >= Len(String1) Then Exit Function
    
    If Not (Compare = vbBinaryCompare) Then
        String1 = UCase(String1)
        String2 = UCase(String2)
    End If
    
    If Left(String2, 1) = "*" Then
        For K = Start To Len(String1)
            If Left$(String1, K) Like String2 Then
                InStrLike = K
                Exit Function
            End If
        Next K
    ElseIf Right(String2, 1) = "*" Then
        For K = Start To Len(String1)
            If Mid$(String1, K) Like String2 Then
                InStrLike = K
                Exit Function
            End If
        Next K
    ElseIf String1 Like String2 Then
        InStrLike = 1
        Exit Function
    End If
    
    InStrLike = 0
End Function

Private Function InStrLikeRev(ByVal String1 As String, ByVal String2 As String, Optional ByVal Start As Long = -1, Optional Compare As VbCompareMethod = vbBinaryCompare) As Long
    Dim K As Long
    
    If Start = -1 Then Start = Len(String1)
    If Start < 1 Then Exit Function
    If Start >= Len(String1) Then Start = Len(String1) - 1
    
    If Not (Compare = vbBinaryCompare) Then
        String1 = UCase(String1)
        String2 = UCase(String2)
    End If
    
    If Left(String2, 1) = "*" Then
        For K = Start To 1 Step -1
            If Left$(String1, K) Like String2 Then
                InStrLikeRev = K
                Exit Function
            End If
        Next K
    ElseIf Right(String2, 1) = "*" Then
        For K = Start To 1 Step -1
            If Mid$(String1, K) Like String2 Then
                InStrLikeRev = K
                Exit Function
            End If
        Next K
    ElseIf String1 Like String2 Then
        InStrLikeRev = 1
        Exit Function
    End If
    
    InStrLikeRev = 0
End Function