Click here to Skip to main content
15,040,003 members
Articles / Programming Languages / Visual Basic
Article
Posted 28 Dec 2020

Tagged as

Stats

11.3K views
1.1K downloads
14 bookmarked

MS Access Queries to SQL Server Converter

Rate me:
Please Sign up or sign in to vote.
5.00/5 (3 votes)
28 Dec 2020CPOL
Tool to migrate MS Access Queries to SQL Server
In this article, you will learn about a tool for Migrating MS Access Queries to SQL Server. It should be used when the Access Queries are using SQL server linked tables.

Image 1

Introduction

To use this application, select Access file, Select a view and click SQL. Click Save All to save all Access queries as SQL files to a folder.

The result SQL will be created using CTE (Common Table Expressions) in case the Access query is using other Access queries. For example:

SQL
With a as (
    select col1 +  col2 as col3
    From table1
)
Select col3
From a

In case Access query is using Access table, the table will be scripted as a CTE with UNION ALL clause. For example:

SQL
 With a as (
    select 1 as col1, 2 as col2 UNION ALL
    select 1 as col1, 2 as col2 
)
Select col1, col2
From a

Using the Code

The tool uses PoorMansTSqlFormatter to make SQL look prettier. To use it, make sure that the “Format SQL” option is checked. I used ILMerge (included in the download) to add PoorMansTSqlFormatterLib35.dll to the AccessToSql2.exe so that I can use it without an installation package.

C:\ILMerge.exe AccessToSql.exe PoorMansTSqlFormatterLib35.dll /out:AccessToSql2.exe

Here is the VB.NET code:

VB.NET
Imports System.Text.RegularExpressions

Public Class Form1

    Dim dicViews As New Hashtable
    Dim dicTables As New Hashtable

    Private Sub btnOpenFile_Click(sender As Object, e As EventArgs) Handles btnOpenFile.Click

        If txtFilePath.Text = "" Then
            OpenFileDialog1.InitialDirectory = ""
        Else
            Dim oFileInfo As New IO.FileInfo(txtFilePath.Text)
            OpenFileDialog1.InitialDirectory = oFileInfo.DirectoryName
            OpenFileDialog1.FileName = oFileInfo.Name
        End If

        OpenFileDialog1.Filter = "Access Files|*.mdb;*.accdb"
        OpenFileDialog1.ShowDialog()
        txtFilePath.Text = OpenFileDialog1.FileName
        LoadViews()
    End Sub

    Private Function GetConnection() As Data.OleDb.OleDbConnection

        Dim cn As New Data.OleDb.OleDbConnection
        Dim sError As String = ""

        If System.IO.Path.GetExtension(txtFilePath.Text).ToLower() = _
                 ".mdb" And Environment.Is64BitProcess = False Then
            Try
                cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;_
                Data Source=" & txtFilePath.Text & ";"
                cn.Open()
                Return cn
            Catch ex As Exception
                sError = ex.Message
            End Try
        End If

        Try
            cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                                   txtFilePath.Text & ";"
            cn.Open()
            Return cn
        Catch ex As Exception
            'The 'Microsoft.ACE.OLEDB.12.0' provider is not registered on the local machine.
            If ex.Message.IndexOf("Microsoft.ACE.OLEDB") <> -1 Then
                If MsgBox("Error: " & ex.Message & " _
                Install Microsoft Access Database Engine 2016 Redistributable?", _
                    MsgBoxStyle.YesNo) = vbYes Then
                    Process.Start("https://www.microsoft.com/en-us/download/_
                                   details.aspx?id=54920&WT.mc_id=rss_alldownloads_all")
                End If
                Me.Close()
            Else
                MsgBox("Error: " & ex.Message)
            End If
        End Try

        Return Nothing
    End Function

    Private cnOleDb As Data.OleDb.OleDbConnection = Nothing

    Private Sub LoadViews()
        If IO.File.Exists(txtFilePath.Text) = False Then
            Exit Sub
        End If

        dicViews = New Hashtable

        cnOleDb = GetConnection()
        If cnOleDb Is Nothing Then
            Exit Sub
        End If

        Dim oStopwatch As Stopwatch = Stopwatch.StartNew()
        Dim oTable As DataTable = cnOleDb.GetOleDbSchemaTable_
                                  (Data.OleDb.OleDbSchemaGuid.Views, Nothing)

        oStopwatch.Stop()
        If oStopwatch.Elapsed.TotalSeconds() > 10 Then
            MsgBox("It took " & oStopwatch.Elapsed.TotalSeconds() _
            & " seconds to cnOleDb.GetOleDbSchemaTable_
                           (Data.OleDb.OleDbSchemaGuid.Views, Nothing)")
        End If

        For i As Long = 0 To oTable.Rows.Count - 1
            Dim sName As String = oTable.Rows(i)("TABLE_NAME") & ""
            Dim sSql As String = oTable.Rows(i)("VIEW_DEFINITION") & ""
            dicViews(sName) = sSql
        Next

        oStopwatch.Restart()
        oTable = cnOleDb.GetOleDbSchemaTable(Data.OleDb.OleDbSchemaGuid.Procedures, Nothing)
        If oStopwatch.Elapsed.TotalSeconds() > 10 Then
            MsgBox("It took " & oStopwatch.Elapsed.TotalSeconds() _
            & " seconds to cnOleDb.GetOleDbSchemaTable_
                           (Data.OleDb.OleDbSchemaGuid.Procedures, Nothing)")
        End If

        For i As Long = 0 To oTable.Rows.Count - 1
            Dim sName As String = oTable.Rows(i)("PROCEDURE_NAME") & ""
            Dim sSql As String = oTable.Rows(i)("PROCEDURE_DEFINITION") & ""

            If sName.Substring(0, 4) <> "~sq_" _
                AndAlso dicViews.ContainsKey(sName) = False Then
                dicViews(sName) = sSql
            End If

        Next

        Dim oList As New SortedList
        For Each oEntry As DictionaryEntry In dicViews
            oList.Add(oEntry.Key, oEntry.Value)
        Next

        cmViews.Items.Clear()
        For Each oEntry As DictionaryEntry In oList
            cmViews.Items.Add(oEntry.Key)
        Next

        dicTables = New Hashtable
        oTable = cnOleDb.GetOleDbSchemaTable(Data.OleDb.OleDbSchemaGuid.Tables, Nothing)
        For i As Long = 0 To oTable.Rows.Count - 1
            Dim sType As String = oTable.Rows(i)("TABLE_TYPE") & ""
            Dim sName As String = oTable.Rows(i)("TABLE_NAME") & ""
            If sType = "TABLE" Then
                dicTables(sName) = ""
            End If
        Next

    End Sub

    Private Sub btnGo_Click(sender As Object, e As EventArgs) Handles btnGo.Click
        Dim sViewName As String = cmViews.Text

        If sViewName = "" Then
            Dim oAppSetting As New AppSetting
            cmViews.SelectedItem = oAppSetting.GetValue("View")
            sViewName = cmViews.Text
        End If

        If sViewName = "" Then
            MsgBox("Please select a view")
        Else
            txtSQL.Text = ShowView(sViewName, True)
        End If
    End Sub

    Private Function PadTempTableNames(ByVal sSql As String, _
    dicDepTables As Hashtable, dicDepViews As Hashtable) As String

        If chkCTE.Checked Then
            Return sSql
        End If

        For Each oEntry As Collections.DictionaryEntry In dicDepTables
            Dim sTable As String = oEntry.Key
            sSql = ReplaceTempTable(sSql, sTable)
        Next

        For Each oEntry As Collections.DictionaryEntry In dicDepViews
            Dim sTable As String = oEntry.Key
            sSql = ReplaceTempTable(sSql, sTable)
        Next

        Return sSql
    End Function

    Private Function PadTempTableNames(ByVal sSql As String, _
    dicDepTables As System.Windows.Forms.ListBox.ObjectCollection, _
    dicDepViews As System.Windows.Forms.ListBox.ObjectCollection) As String

        If chkCTE.Checked Then
            Return sSql
        End If

        For Each sDisplayTable As String In dicDepTables

            Dim sTable As String = ""
            If sDisplayTable.IndexOf(" - [") <> -1 Then
                sTable = System.Text.RegularExpressions.Regex.Split(sDisplayTable, " - [")(0)
            Else
                sTable = sDisplayTable
            End If

            sSql = ReplaceTempTable(sSql, sTable)
        Next

        For Each sTable As String In dicDepViews
            sSql = ReplaceTempTable(sSql, sTable)
        Next

        Return sSql
    End Function

    Private Function ReplaceTempTable(ByVal sSql As String, ByVal sTable As String) As String
        Return Replace(sSql, "[" & sTable & "]", "[#" & sTable & "]")
    End Function

    Private Function GetTableCount(ByVal sTable As String) As Integer
        If cnOleDb Is Nothing Then
            Return 0
        End If

        Try
            Dim iRet As Integer = 0
            Dim sSql As String = "select count(*) from [" & sTable & "]"
            Dim cmd As New OleDb.OleDbCommand(sSql, cnOleDb)
            Dim dr As OleDb.OleDbDataReader = cmd.ExecuteReader()
            If dr.Read Then
                iRet = dr.GetValue(0)
            End If
            dr.Close()
            Return iRet
        Catch ex As Exception

        End Try

        Return -1
    End Function

    Private Function ShowView_
            (ByVal sViewName As String, ByVal bUpdateList As Boolean) As String

        If dicViews.ContainsKey(sViewName) = False Then
            Return ""
        End If

        Dim dicDepTables As New Hashtable
        Dim dicDepViews As New Hashtable
        Dim sVewSql As String = dicViews(sViewName)
        GetDepViews(sVewSql, dicDepTables, dicDepViews, 1)

        Dim bShowWith As Boolean = False
        Dim sSql As String = ""

        If bUpdateList Then
            lbDepTables.Items.Clear()
        End If

        For Each oEntry As Collections.DictionaryEntry In dicDepTables
            Dim sTable As String = oEntry.Key

            If bUpdateList Then
                Dim iRecordCount As Integer = GetTableCount(sTable)
                Dim sDisplayTable As String = _
                                  sTable & " - [" & Format(iRecordCount, "#,#") & "]"

                If txtRowLimit.Text <> "" AndAlso IsNumeric(txtRowLimit.Text) Then
                    Dim iMaxRecCount As Integer = txtRowLimit.Text
                    If iMaxRecCount < iRecordCount Then
                        sDisplayTable = sTable & " - _
                                        [" & Format(iRecordCount, "#,#") & " !!!]"
                    End If
                End If

                lbDepTables.Items.Add(sDisplayTable)
            End If

            Dim sTableSql As String = GetTableSql(sTable)
            If sTableSql <> "" Then
                If chkCTE.Checked Then

                    If sSql <> "" Then
                        sSql += ", "
                    End If

                    sSql += " [" & sTable & "] AS (" & vbCrLf & sTableSql & ")" & vbCrLf
                    bShowWith = True
                Else
                    sSql += "IF OBJECT_ID('tempdb..[#" & sTable & "]') _
                    is not null drop table [#" & sTable & "]" & vbCrLf
                    sSql += "select * into [#" & sTable & "] _
                    from (" & vbCrLf & sTableSql & vbCrLf & ") xx" & vbCrLf & vbCrLf
                End If
            End If
        Next

        If bUpdateList Then
            lbDepViews.Items.Clear()
        End If

        Dim oSortedViews As ArrayList = GetSortedViews(dicDepViews)
        For Each sDepViewName In oSortedViews

            If bUpdateList Then
                lbDepViews.Items.Add(sDepViewName)
            End If

            Dim sDepSql As String = dicViews(sDepViewName)
            sDepSql = PadSql(sDepSql)
            sDepSql = AddTabs(sDepSql)

            If chkCTE.Checked Then
                If sSql <> "" Then
                    sSql += ", "
                End If

                sSql += " [" & sDepViewName & "] AS (" & vbCrLf & sDepSql & ")" & vbCrLf
                bShowWith = True
            Else
                sSql += "IF OBJECT_ID('tempdb..[#" & sDepViewName & "]') _
                is not null drop table [#" & sDepViewName & "]" & vbCrLf
                sSql += "select * into [#" & sDepViewName & "] _
                from (" & vbCrLf & _
                PadTempTableNames(sDepSql, dicDepTables, dicDepViews) _
                                  & vbCrLf & ") xx" & vbCrLf
            End If
        Next

        If chkCTE.Checked = False Then
            Return sSql & PadTempTableNames(PadSql(sVewSql), dicDepTables, dicDepViews)

        ElseIf bShowWith Then
            Return "WITH " & sSql & PadSql(sVewSql)
        Else
            Return PadSql(sVewSql)
        End If

    End Function

    Private Function ShowView2() As String

        Dim sViewName As String = cmViews.Text

        If dicViews.ContainsKey(sViewName) = False Then
            Return ""
        End If

        Dim sVewSql As String = dicViews(sViewName)

        Dim bShowWith As Boolean = False
        Dim sSql As String = ""

        For Each sDisplayTable As String In lbDepTables.Items

            Dim sTable As String = ""
            If sDisplayTable.IndexOf(" - [") <> -1 Then
                sTable = System.Text.RegularExpressions.Regex.Split(sDisplayTable, " - [")(0)
            Else
                sTable = sDisplayTable
            End If

            Dim sTableSql As String = GetTableSql(sTable)
            If sTableSql <> "" Then
                If chkCTE.Checked Then

                    If sSql <> "" Then
                        sSql += ", "
                    End If

                    sSql += " [" & sTable & "] AS (" & vbCrLf & sTableSql & ")" & vbCrLf
                    bShowWith = True
                Else
                    sSql += "IF OBJECT_ID('tempdb..[#" & sTable & "]') _
                    is not null drop table [#" & sTable & "]" & vbCrLf
                    sSql += "select * into [#" & sTable & "] _
                    from (" & vbCrLf & sTableSql & vbCrLf & ") xx" & vbCrLf
                End If
            End If
        Next

        For Each sDepViewName In lbDepViews.Items

            Dim sDepSql As String = dicViews(sDepViewName)
            sDepSql = PadSql(sDepSql)
            sDepSql = AddTabs(sDepSql)

            If chkCTE.Checked Then

                If sSql <> "" Then
                    sSql += ", "
                End If

                sSql += " [" & sDepViewName & "] AS (" & vbCrLf & sDepSql & ")" & vbCrLf
                bShowWith = True
            Else
                sSql += "IF OBJECT_ID('tempdb..[#" & sDepViewName & "]') _
                is not null drop table [#" & sDepViewName & "]" & vbCrLf
                sSql += "select * into [#" & sDepViewName & "] _
                from (" & vbCrLf & PadTempTableNames_
                (sDepSql, lbDepTables.Items, lbDepViews.Items) & vbCrLf & ") xx" & vbCrLf
            End If
        Next

        If chkCTE.Checked = False Then
            Return sSql & _
            PadTempTableNames(PadSql(sVewSql), lbDepTables.Items, lbDepViews.Items)

        ElseIf bShowWith Then
            Return "WITH " & sSql & PadSql(sVewSql)
        Else
            Return sSql & PadSql(sVewSql)
        End If

    End Function

    Private Function GetSortedViews(ByVal oHash As Hashtable) As ArrayList
        'Sort list based on recursion level - views at the bottom are lsted first
        Dim oTable As New Data.DataTable
        oTable.Columns.Add(New Data.DataColumn("key"))
        oTable.Columns.Add(New Data.DataColumn("level", System.Type.GetType("System.Int32")))

        Dim oDepList As New Hashtable

        For Each oEntry As Collections.DictionaryEntry In oHash
            Dim sView As String = oEntry.Key

            Dim oDataRow As DataRow = oTable.NewRow()
            oDataRow("key") = sView
            oDataRow("level") = oEntry.Value
            oTable.Rows.Add(oDataRow)

            Dim dicSubDepViews As New Hashtable
            Dim sDepVewSql As String = dicViews(sView)
            GetDepViews(sDepVewSql, Nothing, dicSubDepViews, 1)
            If dicSubDepViews.ContainsKey(sView) Then
                'Exclude youself from the dep list
                dicSubDepViews.Remove(sView)
            End If
            oDepList(sView) = dicSubDepViews
        Next

        Dim oTempList As New Hashtable
        Dim oDeleteList As New Hashtable
        Dim oRet As New ArrayList()
        Dim oDataView As DataView = New DataView(oTable)
        oDataView.Sort = "level DESC"

        For iRow As Long = 0 To oDataView.Count - 1

            For Each oTempEntry As Collections.DictionaryEntry In oTempList
                Dim sView As String = oTempEntry.Key
                If oDeleteList.ContainsKey(sView) = False Then
                    Dim oViews As Hashtable = oDepList(sView)
                    If HashNotInList(oViews, oRet) = False Then
                        oRet.Add(sView)
                        oDeleteList(sView) = True
                    End If
                End If
            Next

            Dim sDepViewName As String = oDataView(iRow)("key")
            Dim dicSubDepViews As Hashtable = oDepList(sDepViewName)

            If HashNotInList(dicSubDepViews, oRet) Then
                'View has dependenies not listed above
                oTempList(sDepViewName) = True
            Else
                oRet.Add(sDepViewName)
            End If
        Next

        'Flush remaining items in temp list
        For Each oTempEntry As Collections.DictionaryEntry In oTempList
            Dim sView As String = oTempEntry.Key
            If oDeleteList.ContainsKey(sView) = False Then
                Dim oViews As Hashtable = oDepList(sView)
                If HashNotInList(oViews, oRet) = False Then
                    oRet.Add(sView)
                    oDeleteList(sView) = True
                End If
            End If
        Next

        Return oRet
    End Function

    Private Function HashNotInList_
            (ByRef oHash As Hashtable, ByRef oList As ArrayList) As Boolean

        If oHash.Count = 0 Then
            Return False
        End If

        For Each oEntry As Collections.DictionaryEntry In oHash
            Dim sKey As String = oEntry.Key
            Dim bKeyInList As Boolean = False
            For j As Integer = 0 To oList.Count - 1
                If oList(j) = sKey Then
                    bKeyInList = True
                End If
            Next

            If bKeyInList = False Then
                Return True
            End If
        Next

        Return False
    End Function

    Private Function GetTableSql(ByVal sTableName As String) As String
        If txtRowLimit.Text = "" Then
            Return ""
        End If

        Dim iMaxRows As Integer = txtRowLimit.Text
        If iMaxRows = 0 Then
            Return ""
        End If

        Dim cn As Data.OleDb.OleDbConnection = GetConnection()
        Dim iRow As Integer = 0
        Dim oRet As New System.Text.StringBuilder()
        Dim sSql As String = "select * from [" & sTableName & "]"


        'sSql += " WHERE EMPLOYEE = 3237975"

        Dim cmd As New Data.OleDb.OleDbCommand(sSql, cn)
        Dim dr As Data.OleDb.OleDbDataReader

        Try
            dr = cmd.ExecuteReader()
        Catch ex As Exception
            Return "GetTableSql for " & sTableName & ". Error: " & Err.Description
        End Try

        Dim oSchemaRows As Data.DataRowCollection = dr.GetSchemaTable.Rows

        While dr.Read()
            iRow += 1

            If iRow <= iMaxRows Then
                Dim sRow As String = ""

                For iCol As Integer = 0 To oSchemaRows.Count - 1
                    Dim sDataType As String = oSchemaRows(iCol).Item("DATATYPE").FullName
                    Dim sVal As String = ""
                    If sDataType = "System.Byte[]" Then
                        sVal = GetBinaryData(dr, iCol)
                    Else
                        sVal = dr.GetValue(iCol) & ""
                    End If

                    Dim sColumn As String = oSchemaRows(iCol).Item("ColumnName")

                    If sRow <> "" Then
                        sRow += ", "
                    End If

                    Select Case sDataType
                        Case "System.Short", "System.Integer", _
                        "System.Long", "System.Decimal", "System.Int32", "System.Int64"
                            If sVal = "" Then
                                sRow += "NULL"
                            Else
                                sRow += sVal
                            End If
                        Case Else
                            sRow += "'" & Replace(sVal, "'", "''") & "'"
                    End Select

                    sRow += " as [" & sColumn & "]"
                Next

                If iRow > 1 Then
                    oRet.Append(" union all" & vbCrLf)
                End If

                oRet.Append(vbTab & "select " & sRow)
            End If

        End While

        dr.Close()
        cn.Close()

        If iRow > 1 Then
            Return oRet.ToString() & vbCrLf
        Else
            Return ""
        End If

    End Function

    Private Function GetBinaryData_
            (ByRef dr As Data.OleDb.OleDbDataReader, ByVal iCol As Integer) As String

        Dim iBufferSize As Integer = 1000
        Dim oBuffer(iBufferSize - 1) As Byte
        Dim iByteCount As Long     'The bytes returned from GetBytes.
        Dim iStartIndex As Long = 0     'The starting position in the BLOB output

        Dim oMemoryStream As IO.MemoryStream = Nothing
        Dim oBinaryWriter As IO.BinaryWriter = Nothing
        Dim sRet As String = ""

        If IsDBNull(dr.GetValue(iCol)) = False Then

            oMemoryStream = New IO.MemoryStream()
            oBinaryWriter = New IO.BinaryWriter(oMemoryStream)

            iByteCount = dr.GetBytes(iCol, iStartIndex, oBuffer, 0, iBufferSize)

            'Continue reading and writing while there are bytes beyond the size of the buffer.
            While (iByteCount = iBufferSize)
                oBinaryWriter.Write(oBuffer)

                iStartIndex += iBufferSize
                iByteCount = dr.GetBytes(iCol, iStartIndex, oBuffer, 0, iBufferSize)
            End While

            If iByteCount > 2 Then
                ReDim Preserve oBuffer(iByteCount - 2)
                oBinaryWriter.Write(oBuffer)
            End If

            oBinaryWriter.Flush()
            oMemoryStream.Position = 0
            Dim oStreamReader As _
                New IO.StreamReader(oMemoryStream, System.Text.Encoding.Unicode)
            sRet = oStreamReader.ReadToEnd()
            oStreamReader.Close()
            oMemoryStream.Close()
        End If

        Return sRet
    End Function

    Private Function AddTabs(ByVal sSql As String) As String
        Dim sRet As String = ""

        Dim oSql As String() = Regex.Split(sSql, vbCrLf)
        For i As Integer = 0 To oSql.Length - 1
            sRet += vbTab & oSql(i)

            If i < oSql.Length - 1 Then
                sRet += vbCrLf
            End If
        Next

        Return sRet
    End Function

    Private Function RegexReplace_
    (ByRef sText As String, ByRef sPattern As String, ByRef sReplace As String) As String
        Return Regex.Replace(sText, sPattern, sReplace, RegexOptions.IgnoreCase)
    End Function

    Private Function PadSql(ByVal sSql As String) As String

        If chkReplace.Checked Then

            sSql = Replace(sSql, "dbo_", "")
            sSql = Replace(sSql, "DBO_", "")

            sSql = Replace(sSql, """", "'")
            sSql = Replace(sSql, "#", "'")
            sSql = Replace(sSql, ";", "")

            sSql = RegexReplace(sSql, "\bVal\(", "Convert(decimal,")
            sSql = RegexReplace(sSql, "\bMid\(", "substring(")
            sSql = RegexReplace(sSql, "\bLast\(", "Max(") 'LAST_VALUE - SQL Server 2016

            'IsNull([Original_Salary]) = - 1  => [Original_Salary] IS NULL

            Dim oDepViews As Hashtable = GetDepViews(sSql)
            For Each oEntry As Collections.DictionaryEntry In oDepViews
                Dim sView As String = oEntry.Key
                sSql = Replace(sSql, "[" & sView & "]!", "[" & sView & "].")
            Next

            'IIf( -> case when
            Dim oRegEx As New Regex("IIf\(([^,]*),([^,]*),([^,]*)\)", RegexOptions.IgnoreCase)
            Dim oMatches As MatchCollection = oRegEx.Matches(sSql)
            For Each oMatch As Match In oMatches
                If oMatch.Groups.Count > 2 Then
                    Dim sFind As String = oMatch.Groups(0).Value
                    Dim a As String = oMatch.Groups(1).Value
                    Dim b As String = oMatch.Groups(2).Value
                    Dim c As String = oMatch.Groups(3).Value
                    Dim sReplace As String = "case when " & a & " _
                                 then " & b & " else " & c & " end "
                    sSql = Replace(sSql, sFind, sReplace)
                End If
            Next

            'IsNull([Original_Salary])=-1
            oRegEx = New Regex("IsNull\(([^,]*)\)=-1", RegexOptions.IgnoreCase)
            oMatches = oRegEx.Matches(sSql)
            For Each oMatch As Match In oMatches
                If oMatch.Groups.Count > 1 Then
                    Dim sFind As String = oMatch.Groups(0).Value
                    Dim a As String = oMatch.Groups(1).Value
                    Dim sReplace As String = a & " is null"
                    sSql = Replace(sSql, sFind, sReplace)
                End If
            Next

            For Each oEntry As DictionaryEntry In dicTables
                Dim sName As String = oEntry.Key
                If sName.Substring(0, 4).ToLower() = "dbo_" Then
                    sName = sName.Substring(4)
                    sSql = Replace(sSql, "[" & sName & "]!", "[" & sName & "].")
                    sSql = Replace(sSql, sName & "!", sName & ".")
                End If
            Next

            For Each oEntry As DictionaryEntry In dicViews
                Dim sName As String = oEntry.Key
                sSql = Replace(sSql, "[" & sName & "]!", "[" & sName & "].")
                sSql = Replace(sSql, sName & "!", sName & ".")
            Next

        End If

        sSql = ParseSql(sSql)
        Return sSql
    End Function

    Private Function ParseSql(ByVal sql As String)

        If chkFormatSql.Checked = False Then
            Return sql
        End If

        Dim _tokenizer As New PoorMansTSqlFormatterLib.Tokenizers.TSqlStandardTokenizer()
        Dim _parser = New PoorMansTSqlFormatterLib.Parsers.TSqlStandardParser()
        Dim _treeFormatter As New PoorMansTSqlFormatterLib.Formatters.TSqlStandardFormatter()

        Dim tokenized As PoorMansTSqlFormatterLib.TokenList = _tokenizer.TokenizeSQL(sql)
        Dim parsed As PoorMansTSqlFormatterLib.ParseStructure.Node = _
                             _parser.ParseSQL(tokenized)
        Dim sRet As String = _treeFormatter.FormatSQLTree(parsed)

        If sRet.IndexOf("--WARNING! ERRORS ENCOUNTERED DURING SQL PARSING!") <> -1 Then
            Return sql
        End If

        Return sRet
    End Function

    Private Sub GetDepViews(ByVal sSql As String, _
    ByRef dicDepTables As Hashtable, ByRef dicDepViews As Hashtable, ByRef iLevel As Integer)
        If iLevel > 1000 Then
            'prevent infinate recursive loops
            Exit Sub
        End If

        If Not dicDepTables Is Nothing Then
            For Each oEntry As DictionaryEntry In dicTables
                Dim sName As String = oEntry.Key
                If sName.Substring(0, 4).ToLower() <> "dbo_" Then
                    Dim oRegEx As New Regex("\b" & sName & "\b", RegexOptions.IgnoreCase)
                    If sSql.ToLower().IndexOf("[" & sName.ToLower() & "]") <> -1 _
                    OrElse oRegEx.IsMatch(sSql) Then
                        If sSql.ToLower().IndexOf("into [" & sName.ToLower() & "]") = -1 Then
                            dicDepTables(sName) = True
                        End If
                    End If
                End If
            Next
        End If

        For Each oEntry As DictionaryEntry In dicViews
            Dim sName As String = oEntry.Key

            Dim oRegEx As New Regex("\b" & sName & "\b", RegexOptions.IgnoreCase)

            If sSql.ToLower().IndexOf("[" & sName.ToLower() & "]") <> -1 _
            OrElse oRegEx.IsMatch(sSql) Then
                If dicDepViews.ContainsKey(sName) = False Then
                    dicDepViews.Add(sName, iLevel)

                    GetDepViews(oEntry.Value, dicDepTables, dicDepViews, iLevel + 1)
                End If

            End If
        Next
    End Sub


    Private Function GetDepViews(ByVal sSql As String) As Hashtable
        Dim oRet As New Hashtable

        For Each oEntry As DictionaryEntry In dicViews
            Dim sName As String = oEntry.Key

            Dim oRegEx As New Regex("\b" & sName & "\b", RegexOptions.IgnoreCase)

            If sSql.ToLower().IndexOf("[" & sName.ToLower() & "]") <> -1 _
            OrElse oRegEx.IsMatch(sSql) Then
                If oRet.ContainsKey(sName) = False Then
                    oRet.Add(sName, True)

                End If
            End If
        Next

        Return oRet
    End Function

    Private Sub txtFilePath_LostFocus(sender As Object, e As EventArgs) _
                                      Handles txtFilePath.LostFocus
        If txtFilePath.Text <> "" Then
            LoadViews()
        End If
    End Sub

    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) _
                                  Handles Me.FormClosing
        Dim oAppSetting As New AppSetting
        oAppSetting.SetValue("FilePath", txtFilePath.Text)
        oAppSetting.SetValue("RowLimit", txtRowLimit.Text)
        oAppSetting.SetValue("View", cmViews.SelectedItem)

        oAppSetting.SetValue("FormatSql", IIf(chkFormatSql.Checked, "1", "0"))
        oAppSetting.SetValue("Replace", IIf(chkReplace.Checked, "1", "0"))
        oAppSetting.SetValue("CTE", IIf(chkCTE.Checked, "1", "0"))

        oAppSetting.SaveData()

        If (Not cnOleDb Is Nothing) AndAlso cnOleDb.State = ConnectionState.Open Then
            cnOleDb.Close()
        End If

    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        Dim oAppSetting As New AppSetting
        txtFilePath.Text = oAppSetting.GetValue("FilePath")
        txtRowLimit.Text = oAppSetting.GetValue("RowLimit", "1000")

        chkFormatSql.Checked = oAppSetting.GetValue("FormatSql", "1") = "1"
        chkReplace.Checked = oAppSetting.GetValue("Replace", "1") = "1"
        chkCTE.Checked = oAppSetting.GetValue("CTE", "1") = "1"

        LoadViews()
        cmViews.SelectedItem = oAppSetting.GetValue("View")
    End Sub

    Private Sub btnSelectAll_Click(sender As Object, e As EventArgs) Handles btnSelectAll.Click

        If txtSQL.Text = "" Then
            Exit Sub
        End If

        txtSQL.SelectAll()
        txtSQL.Focus()
        Clipboard.Clear()
        Clipboard.SetText(txtSQL.Text)
    End Sub

    Private Sub btnSaveAll_Click(sender As Object, e As EventArgs) Handles btnSaveAll.Click

        Dim sAssPath As String = System.Reflection.Assembly.GetExecutingAssembly().Location
        Dim sPath As String = System.IO.Path.GetDirectoryName(sAssPath)
        Dim sFolderPath As String = System.IO.Path.Combine(sPath, "SQL")

        If IO.Directory.Exists(sFolderPath) Then
            For i As Integer = 1 To 1000
                If IO.Directory.Exists(sFolderPath & i) = False Then
                    sFolderPath = sFolderPath & i
                    Exit For
                End If
            Next
        End If

        If IO.Directory.Exists(sFolderPath) = False Then
            IO.Directory.CreateDirectory(sFolderPath)
        End If

        ProgressBar1.Visible = True
        ProgressBar1.Minimum = 1
        ProgressBar1.Maximum = dicViews.Count
        Dim iCount As Integer = 0

        For Each oEntry As DictionaryEntry In dicViews
            Dim sViewName As String = oEntry.Key
            Dim sSql As String = ShowView(sViewName, False)
            Dim sFilePath As String = System.IO.Path.Combine(sFolderPath, sViewName & ".sql")
            Dim oFile As New IO.StreamWriter(sFilePath, True)
            oFile.Write(sSql)
            oFile.Close()

            iCount += 1
            ProgressBar1.Value = iCount
            System.Windows.Forms.Application.DoEvents()
        Next

        ProgressBar1.Visible = False

        Process.Start("explorer.exe", String.Format("/n, /e, {0}", sFolderPath & "\"))
    End Sub

    Private Sub btnUp_Click(sender As Object, e As EventArgs) Handles btnUp.Click
        Dim i As Integer = lbDepViews.SelectedIndex

        If i = -1 OrElse lbDepViews.Items.Count < 2 OrElse i = 0 Then
            Exit Sub
        End If

        Dim a As String = lbDepViews.Items(i - 1)
        Dim b As String = lbDepViews.Items(i)

        lbDepViews.Items(i - 1) = b
        lbDepViews.Items(i) = a

        lbDepViews.SelectedIndex += -1
        txtSQL.Text = ShowView2()
    End Sub

    Private Sub btnDown_Click(sender As Object, e As EventArgs) Handles btnDown.Click
        Dim i As Integer = lbDepViews.SelectedIndex

        If i = -1 OrElse lbDepViews.Items.Count < 2 _
          OrElse i = lbDepViews.Items.Count - 1 Then
            Exit Sub
        End If

        Dim a As String = lbDepViews.Items(i)
        Dim b As String = lbDepViews.Items(i + 1)

        lbDepViews.Items(i) = b
        lbDepViews.Items(i + 1) = a

        lbDepViews.SelectedIndex += 1

        txtSQL.Text = ShowView2()
    End Sub

    Private Sub txtFilePath_TextChanged(sender As Object, e As EventArgs) _
                                        Handles txtFilePath.TextChanged

    End Sub
End Class

Here is the VBS script (AccessView.vbs) that creates a CSV file to show all MS Access linked tables and queries.

VBScript
if WScript.Arguments.Count = 0 then
  MsgBox "Please drag and drop MS Acccess file"
    wscript.Quit
End if

sFile = WScript.Arguments(0)

If Not (lcase(right(sFile,4)) = ".mdb" or lcase(right(sFile,6)) = ".accdb") Then
  MsgBox "Please drag and drop MS Acccess file not: " & sFile
    wscript.Quit
End If

Set fso = CreateObject("Scripting.FileSystemObject")
sLogFile = sFile & ".csv"

If fso.FileExists(sLogFile) Then
  On Error resume next
  fso.DeleteFile sLogFile, True
  
  If Err.Number <> 0 Then
    sLogFile = sFile & "_" & Replace(Replace(Replace(Now(),_
    "/","-"),":","-")," ","_") & ".csv"
    Err.Clear
    On Error goto 0
  End If   
End If

Set oLog = fso.CreateTextFile(sLogFile, True)
oLog.WriteLine "sep=" & vbTab

Dim oApp: Set oApp = createObject("Access.Application")
oApp.visible = False
'oApp.UserControl = true
oApp.OpenCurrentDataBase(sFile)
Dim oDatabase: Set oDatabase = oApp.CurrentDb

Set oNewLinks = CreateObject("Scripting.Dictionary")
Const dbAttachedODBC = 536870912

Dim t 'As TableDef
For Each t In oDatabase.TableDefs
    If (t.Attributes And dbAttachedODBC) And t.SourceTableName <> "" _
    Then 'If the table source is other than a base table
        oLog.WriteLine "Table" & vbTab & t.Name & _
                        vbTab & t.SourceTableName & vbTab & t.Connect
    End If
Next

Dim q 'As QueryDef
For Each q In oDatabase.QueryDefs
    If q.Connect <> "" Then 'q.Type 112
      oLog.WriteLine "Query" & vbTab & q.Name & vbTab & """" & _
      Replace(q.SQL,"""","'") & """" & vbTab & q.Connect        
    End If
Next

oApp.Quit
Set oApp = Nothing
oLog.Close 

Set oExcel = CreateObject("Excel.Application")
oExcel.visible = True
Set workbook = oExcel.Workbooks.Open(sLogFile)

MsgBox "Created " & sLogFile

Here is the VBS script (AccessUpdate.vbs) that will update a MS Access to point all linked tables and queries to another SQL Server location

VBScript
sConnect = "ODBC;DRIVER=SQL Server;Server=NewServer1;_
            Database=NewDb1;Uid=User1;Pwd=Password123;"

if WScript.Arguments.Count = 0 then
  MsgBox "Please drag and drop MS Acccess file"
    wscript.Quit
End if

sFile = WScript.Arguments(0)

If Not (lcase(right(sFile,4)) = ".mdb" or lcase(right(sFile,6)) = ".accdb") Then
  MsgBox "Please drag and drop MS Acccess file not: " & sFile
    wscript.Quit
End If

Dim oApp: Set oApp = createObject("Access.Application")
oApp.visible = False
oApp.UserControl = true
oApp.OpenCurrentDataBase(sFile)
Dim oDatabase: Set oDatabase = oApp.CurrentDb

oApp.DoCmd.NavigateTo "acNavigationCategoryObjectType"
'oApp.DoCmd.RunCommand 2 'acCmdWindowHide
oApp.DoCmd.SelectObject 0, , True 'cTable = 0

Set oTables = CreateObject("Scripting.Dictionary")
Set oNewLinks = CreateObject("Scripting.Dictionary")
Const dbAttachedODBC = 536870912
Const dbAttachSavePWD = 131072

Dim t 'As TableDef
For Each t In oDatabase.TableDefs
    If (t.Attributes And dbAttachedODBC) And t.SourceTableName <> "" _
    Then 'If the table source is other than a base table

      sTableConnect = sConnect
      If lcase(right(t.SourceTableName,5)) = "_view" Then
        sTableConnect = Replace(sConnect,";Database=OldDb1",";Database=NewDb1")
      End If

      If Right(t.Name,7) <> "_delete" And t.Connect <> sTableConnect Then
     
        bNewLink = False

        If InStr(1, t.SourceTableName, "new_schema1.") = 0 Then
          oTables(Replace(t.SourceTableName, "dbo.", "")) = True
        End If

        sSourceTableName = Replace(t.SourceTableName, "dbo.", "new_schema1.")             
        If sSourceTableName <> t.SourceTableName Then
        
          sName = t.Name
          t.Name = sName & "_delete"
          
          Set n = oDatabase.CreateTableDef()
          n.Name = sName
          n.Connect = sTableConnect
          n.Attributes = (n.Attributes Or dbAttachSavePWD)
          n.SourceTableName = sSourceTableName            
          oNewLinks.Add oNewLinks.Count, n
          
          bNewLink = True
        End If

        If bNewLink = False Then
        
          t.Connect = sTableConnect
          
          On Error Resume Next
          t.RefreshLink
          If Err.Number <> 0 Then
            MsgBox "t.RefreshLink - Name: " & t.Name & ", Error: " & Err.Description
            Err.Clear
            On Error GoTo 0
          End If
          
        End If
        
      End If      
    End If
Next

For i = 0 To oNewLinks.Count - 1  
  bSuccess = True
  
  On Error Resume Next
  Set t = oNewLinks.Item(i)    
  oDatabase.TableDefs.Append t
  
  If Err.Number <> 0 Then
    MsgBox "t.RefreshLink - Name: " & t.Name & ", Error: " & Err.Description
    bSuccess = False
    Err.Clear
  End If

  On Error GoTo 0
  
  If bSuccess Then
    oDatabase.TableDefs.Delete t.Name & "_delete"
  End If
Next

Dim q 'As QueryDef
For Each q In oDatabase.QueryDefs
    If q.Connect <> "" Then 'q.Type 112
        q.Connect = sConnect

        If InStr(1, q.SQL, "ls_apps.") = 0 Then
          q.SQL = Replace(q.SQL, "dbo.", "new_schema1.")
          
          For Each sTable in oTables.Keys 
            If sTable <> "" Then
              q.SQL = Replace(q.SQL, vbCrLf & "FROM " & sTable, _
                      vbCrLf & "FROM new_schema1." & sTable)
            End If
          Next
       
        End If          

    End If
Next

MsgBox "Updated " & sFile

History

  • 28th December, 2020: Initial version

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

Igor Krupitsky
Web Developer
United States United States
Igor is a business intelligence consultant working in Tampa, Florida. He has a BS in Finance from University of South Carolina and Masters in Information Management System from University of South Florida. He also has following professional certifications: MCSD, MCDBA, MCAD.

Comments and Discussions

 
QuestionAccess SQL Converter website Pin
Ben Sacheri9-Aug-21 8:48
MemberBen Sacheri9-Aug-21 8:48 
PraiseGreat Utility Pin
Member 1514751212-Apr-21 0:15
MemberMember 1514751212-Apr-21 0:15 
GeneralNot for linked tables Pin
Gustav Brock29-Dec-20 1:54
professionalGustav Brock29-Dec-20 1:54 
QuestionInstall Pin
Member 149566045-Oct-20 19:39
MemberMember 149566045-Oct-20 19:39 
GeneralMy vote of 5 Pin
Sandeep Mewara3-Aug-20 9:04
mvaSandeep Mewara3-Aug-20 9:04 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.