对 SQL 文件的所有 MS Access 查询

Posted 2023-04-19

【中文标题】对 SQL 文件的所有 MS Access 查询

【英文标题】：All MS Access queries to SQL file

【发布时间】：2009-09-14 19:29:03

【问题描述】：

我有一个 MS Access 数据库，其中包含需要每周更新的 10 多个查询。单独导出每一个，然后分别上传到我服务器上的 SQL 真的很痛苦。

我尝试将我的 Access 数据库直接连接到我的 SQL 服务器，但由于安全原因，我的服务器不允许这样做。

我找到了一个模块，它可以在一个文件中打印查询，但它只打印标题，这很有用，但不完全是我想要的。

这是模块代码：

Public Sub IterateQueryDefsCollection() Dim dbMain As DAO.Database Dim qdf As DAO.QueryDef Dim qdfTemp As DAO.QueryDef Set dbMain = CurrentDb For Each qdf In dbMain.QueryDefs Debug.Print qdf.Name 'Prints name of query Set qdfTemp = dbMain.QueryDefs(qdf.Name) Debug.Print qdfTemp.SQL 'Prints SQL Syntax of query Next End Sub

我不编写这些代码，而且对 SQL 还是很陌生，所以我的问题是……有没有办法将我的所有查询连同它们的数据一起导出到 .sql 文件中。

提前谢谢你。

【参考方案1】：

您的 SQL 服务器的身份验证过程不“知道”谁或什么应用程序正在尝试连接到它。如果您提供有效的凭据，那么它应该接受连接尝试。当您正常连接到 SQL Server 时，您提供什么类型的凭据？ （当它工作时）在您指定 Access 尝试连接的凭据时使用相同的凭据，并且 Access 连接也将工作。如果您在 access 中创建了一个链接表，Access 应该要求您指定这些连接凭据。一旦你有一个有效的链接表，连接到 sql server，你将能够对 SQL Server 表运行 Access 查询（使用 Access 链接表作为指针）

【参考方案2】：

我不明白您为什么要每周更新十个查询。在我看来，这些应该是参数驱动的，等等。请注意，以下内容不是移动数据。在我看来，代码中的一些附加查询应该可以很好地处理。

以下是我编写的一个模块，用于尝试将 Access MDB 中的所有查询升迁到服务器。请注意，由于其中一些查询是“堆叠的”，即它们称为其他查询，因此您必须多次运行此子例程，直到它无法再增大。

    Sub CopyAllQueriesAsViewsDAO()
        Dim strError As String, strQueryName As String, lngQueryID As Long
        Dim Q As QueryDef, blnSuccessfulQ As Boolean
        Dim strSQL As String, strNewSQL As String, strConnect As String
        Dim intCountFailure As Integer, intCountSuccessful As Integer
        Dim intAlreadyAnError As Integer, strAction As String

        Dim mydatabase As DAO.Database, myquerydef As DAO.QueryDef

    On Error GoTo tagError

        strConnect = "ODBC;DRIVER=sql server;DATABASE=" & _
            strTestDatabaseName & ";SERVER=" & strSQLServerName & ";" & _
            "Trusted_Connection=Yes"
        DoCmd.Hourglass True


        For Each Q In dbsPermanent.QueryDefs
            intAlreadyAnError = 0
            strQueryName = Q.Name
            If Left(strQueryName, 4) = "~sq_" Then
            Else
                strError = ""
                strAction = ""
                lngQueryID = FetchQueryID(strQueryName, blnSuccessfulQ) ' Add the record or locate the ID
                If blnSuccessfulQ = False Then
                    strNewSQL = adhReplace(Q.SQL, vbCrLf, " ")
                    strNewSQL = Left(strNewSQL, InStr(strNewSQL, ";") - 1)
                    strNewSQL = ConvertTrueFalseTo10(strNewSQL)

    tagRetryAfterCleanup:
                    Set myquerydef = dbsPermanent.CreateQueryDef("") 'Q.Name & " DAO Test")
                    myquerydef.ReturnsRecords = False
                    myquerydef.Connect = strConnect
                    myquerydef.SQL = "CREATE VIEW [" & strQueryName & "] AS " & strNewSQL
                    myquerydef.Execute
                    myquerydef.Close

                    strSQL = "UPDATE zCreateQueryErrors SET zcqeErrorMsg = 'Successful' " & _
                        "WHERE ID=" & lngQueryID & ";"
                    CurrentDb.Execute strSQL, dbFailOnError
                    intCountSuccessful = intCountSuccessful + 1
                End If
            End If
    tagResumeAfterError:
        Next

        DoCmd.Hourglass False

        MsgBox "There were " & intCountSuccessful & " successful." & vbCrLf & _
            intCountFailure & " failures."


        Exit Sub

    tagError:
      '  MsgBox Err.Description

      Dim errX As DAO.Error, strFunctionName As String, intPosnFunction As Integer
      Dim strThisError As String

        If Errors.Count > 1 Then
            For Each errX In DAO.Errors
                strThisError = mID(errX.Description, 48)
                If intAlreadyAnError > 5 Then  ' Hit 10 errors so don't attempt to clean up the query
                    If errX.Number <> 3146 Then
                        strError = strError & "After fix: " & errX.Number & ": " & strThisError & " "
                    End If
                Else
                    Select Case errX.Number
                    Case 3146 ' Ignore as this is the generic OLE db error
                    Case 195 '  'xxx' is not a recognized function name. > Insert dbo. in front of function name
                        intAlreadyAnError = intAlreadyAnError + 1
                        strFunctionName = mID(strThisError, 2, InStr(2, strThisError, "'") - 2)
                        intPosnFunction = InStr(strNewSQL, strFunctionName)
                        strNewSQL = Left(strNewSQL, intPosnFunction - 1) & "dbo." & mID(strNewSQL, intPosnFunction)
                        strAction = strAction & "Inserted dbo for " & strFunctionName & " "
                        Resume tagRetryAfterCleanup
                    ' The ORDER BY clause is invalid in views, .... , unless TOP is also specified.
                    Case 1033 'TOP 100 PERCENT
                        strNewSQL = Left(strNewSQL, 7) & " TOP 100 PERCENT " & mID(strNewSQL, 8)
                        strAction = strAction & "Inserted TOP 100 PERCENT "
                        Resume tagRetryAfterCleanup
                    Case Else
                        strError = strError & errX.Number & ": " & mID(errX.Description, 48) & " "
                    End Select
                End If
            Next errX
        Else
            strError = Err.Number & ", " & Err.Description
        End If

        strSQL = "UPDATE zCreateQueryErrors SET zcqeErrorMsg = '" & adhHandleQuotes(strError) & "', " & _
            "zcqeAction = '" & strAction & "', zcqeFinalSQL = '" & adhHandleQuotes(strNewSQL) & "' " & _
            "WHERE ID=" & lngQueryID & ";"
        CurrentDb.Execute strSQL, dbFailOnError
        intCountFailure = intCountFailure + 1
        Resume tagResumeAfterError

    End Sub

Public Function ConvertTrueFalseTo10(strIncoming As String)

    Dim strIntermediate As String, intPosn As Integer

    strIntermediate = strIncoming

    intPosn = InStr(strIntermediate, "=false")
    While intPosn <> 0
        strIntermediate = Left(strIntermediate, intPosn - 1) & "=0" & mID(strIntermediate, intPosn + 6)
        intPosn = InStr(strIntermediate, "=false")
    Wend

    intPosn = InStr(strIntermediate, "=true")
    While intPosn <> 0
        strIntermediate = Left(strIntermediate, intPosn - 1) & "=1" & mID(strIntermediate, intPosn + 5)
        intPosn = InStr(strIntermediate, "=true")
    Wend


    ConvertTrueFalseTo10 = strIntermediate

End Function


Function FetchQueryID(strQueryName As String, blnSuccessfulQ As Boolean) As Long

    Dim myRS As Recordset
    Dim strSQL As String
    blnSuccessfulQ = False

    strSQL = "SELECT ID, zcqeErrorMsg FROM zCreateQueryErrors " & _
        "WHERE zcqeName='" & strQueryName & "';"
    Set myRS = dbsPermanent.OpenRecordset(strSQL, dbOpenSnapshot)
    If myRS.EOF Then
        Set myRS = dbsPermanent.OpenRecordset("zCreateQueryErrors", dbOpenSnapshot)
        myRS.AddNew
        myRS!zcqeName = strQueryName
        myRS.Update
        myRS.Move 0, myRS.LastModified
        FetchQueryID = myRS!ID
    Else
        myRS.MoveFirst
        FetchQueryID = myRS!ID
        If myRS!zcqeErrorMsg = "Successful" Then
            blnSuccessfulQ = True
        End If
    End If
    myRS.Close
    Set myRS = Nothing

End Function

Public Function adhHandleQuotes(strValue As String) As String
    ' Fix up all instances of a quote within a string by
    ' breaking up the string, and inserting Chr$(34) whereever
    ' you find a quote within the string.  This way, Jet can
    ' handle the string for searching.
    '
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
    '
    ' Solution suggested by Jurgen Welz, a diligent reader.

    ' In:
    '   strValue:   Value to fix up.
    ' Out:
    '   Return value: the text, with quotes fixed up.
    ' Requires:
    '   adhReplace (or some other function that will replace
    '       one string with another)
    '
    ' Example:
    '    adhHandleQuotes("John "Big-Boy" O'Neil") returns
    '     "John " & Chr$(34) & "Big-Boy" & Chr$(34) & " O'Neil"

   Const QUOTE As String = """"
   Const SingleQUOTE As String = "'"

   adhHandleQuotes = adhReplace(strValue, SingleQUOTE, _
    SingleQUOTE & SingleQUOTE)
 End Function

 Function adhReplace(ByVal varValue As Variant, _
  ByVal strFind As String, ByVal strReplace As String) As Variant

     ' Replace all instances of strFind with strReplace in varValue.

     ' From Access 97 Developer's Handbook
     ' by Litwin, Getz, and Gilbert (Sybex)
     ' Copyright 1997.  All rights reserved.

     ' In:
     '    varValue: value you want to modify
     '    strFind: string to find
     '    strReplace: string to replace strFind with
     '
     ' Out:
     '    Return value: varValue, with all occurrences of strFind
     '     replaced with strReplace.

     Dim intLenFind As Integer
     Dim intLenReplace As Integer
     Dim intPos As Integer

     If IsNull(varValue) Then
         adhReplace = Null
     Else
         intLenFind = Len(strFind)
         intLenReplace = Len(strReplace)

         intPos = 1
         Do
             intPos = InStr(intPos, varValue, strFind)
             If intPos > 0 Then
                 varValue = Left(varValue, intPos - 1) & _
                  strReplace & mID(varValue, intPos + intLenFind)
                 intPos = intPos + intLenReplace
             End If
         Loop Until intPos = 0
     End If
     adhReplace = varValue
 End Function

【参考方案3】：

您询问是否有为此导出 SQL 文件的方法。有，但您必须编写代码来执行此操作，即遍历查询结果的每一行并编写插入语句（即 INSERT INTO (Field1, Field2) VALUES (value1, value2) (value3, value4) , 等等) 是目标数据库引擎的正确 SQL 方言。

但是，导出到 CSV 文件（或制表符分隔或其他）并让您的数据库导入该文件可能很容易。

不过，没有真正的方法知道如何回答您的问题，因为没有足够的详细信息来说明查询的实际作用。如果它们是 INSERT 语句，那么上面的内容正是您想要的。

如果它们是 UPDATES，那就更复杂了。

但也许以上内容可以帮助您入门。

【讨论】：

如果 Access 和 SQL Server 中的字段名称都相同，那么使用 * 代替字段名称应该可以工作。 INSERT INTO Table1 SELECT * FROM Table2;

托尼，我不明白你的建议——我想你假设的是链接表。我假设这不是 Access 而是 Jet/ACE 问题。另外请记住，当您通过 ODBC 从 Access 执行批量插入时，通常会逐行处理。