4

我正在尝试在不触发登录提示的情况下将 MS Access 查询导入 excel。我尝试了几种不同的方法，但两种方法都没有给我一个完整的解决方案。

规格：

  1. 我的访问查询源是 MS Access 2010 中内置的未受保护的访问数据库文件 (database1.accdb)。该数据库从不同来源获取表（通过使用链接表）并执行数据处理。其中一个来源需要密码，因此当我运行查询时，会出现登录提示，要求我提供凭据（我有）。我对查询本身没有任何问题。

  2. 我的 excel 电子表格（内置于 excel 2010）包含从其他数据源检索表的 VBA 代码，其中一些还需要身份验证，因此我构建了一个自定义提示，允许用户输入所有表的凭据。

这里的问题是，我在 excel 电子表格中出现了一个提示，要求用户输入登录信息，但是在导入访问查询时又出现了另一个提示。这是我为解决该问题而尝试做的事情：

方法一：使用宏记录器：

我使用 excel 的内置宏记录器来按照我的手动步骤导入访问查询。当我录制宏时，导入工作正常，并且查询没有出现预期的错误。但是，当我尝试运行宏时，出现运行时错误：

"Run-time error '1004':

The query did not run, or the database could not be opened. Check the database  
server or contact your database administrator. Make sure the external database  
is available and has not been moved or reorganized, then try the operation  
again."

来自宏记录器的代码：

Sub Macro2()
    
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;" _
        , "Data Source=C:\Database1.accdb;Mode=Share Deny Write;" _
        , "Extended Properties="""";Jet OLEDB:System database="""";" _
        , "Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" _
        , "Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;" _
        , "Jet OLEDB:Global Partial Bulk Ops=2;" _
        , "Jet OLEDB:Global Bulk Transactions=1;" _
        , "Jet OLEDB:New Database Password="""";" _
        , "Jet OLEDB:Create System Database=False;" _
        , "Jet OLEDB:Encrypt Database=False;" _
        , "Jet OLEDB:Don't Copy Locale on Compact=False;" _
        , "Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;" _
        , "Jet OLEDB:Support Complex Data=False;" _
        , "Jet OLEDB:Bypass UserInfo Validation=False"), _
        Destination:=Range("$A$4")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("Query3")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = "C:\Database1.accdb"
        .ListObject.DisplayName = "Table_Database1"
        .Refresh BackgroundQuery:=False
    End With
    Range("I3").Select
   
End Sub

我猜测为什么这个宏不起作用（但手动步骤起作用）是因为记录器忽略了一些参数。如果我从某些密码字段中删除引号，代码不会出错，但我会再次收到登录提示。我希望这里有人可以查看是否缺少参数或分配错误的参数。

方法二：使用DAO库：

对于这种方法，我必须进行一些更改。首先，我必须在我的编辑器中为“Microsoft DAO 3.6 Object Library”添加一个引用。然后我不得不将我的 .accdb 文件转换为 .mdb 文件，这样我才能使用 DAO 函数：

DAO 方法的代码：

Sub Macro3()

    Dim db1 As Database
    Dim db2 As Database
    Dim recSet As Recordset
    Dim strConnect As String
   
    Set db1 = OpenDatabase("C:\Database1.mdb")
    strConnect = db1.QueryDefs("Query3").Connect _
    & "DSN=myDsn;USERNAME=myID;PWD=myPassword"
   
    Set db2 = OpenDatabase("", False, False, strConnect)
    db2.Close
    Set db2 = Nothing
   
    Set recSet = db1.OpenRecordset("Query3")
   
    With ActiveSheet.QueryTables.Add(Connection:=recSet, Destination:=Range("$A$4"))
        .Name = "Connection"
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
 
    End With
   
    recSet.Close
    db1.Close
    Set recSet = Nothing
    Set db1 = Nothing
   
End Sub

这种方法有效，我可以绕过数据库的登录提示......只要我的查询不返回大量记录。当我返回大约 60,000 条记录时，代码不会花费超过 5-10 秒的时间来获得结果。但是，当我尝试提取超过 100,000 条记录时，excel 会变得无响应并挂起（我让代码运行了大约 10 分钟，然后才停止它）。我想我在 DAO 上遇到了一些限制，除了我找不到解决这个问题的文档。

任何帮助表示赞赏。

4

2 回答 2

4

尝试这个 ：

Sub ShowData()


   Dim daoDB            As DAO.Database
   Dim daoQueryDef      As DAO.QueryDef
   Dim daoRcd           As DAO.Recordset

    Set daoDB = OpenDatabase("C:\Database1.mdb")  
    Set daoQueryDef = daoDB.QueryDefs("Query3")

    Set daoRcd = daoQueryDef.OpenRecordset
    ThisWorkbook.Worksheets("Sheet1").Range("A4").CopyFromRecordset daoRcd


End Sub

或者这个......在这种情况下，您需要在 VBA 窗口中编写完整的查询

Sub new1()

    Dim objAdoCon       As Object
    Dim objRcdSet       As Object

    Set objAdoCon = CreateObject("ADODB.Connection")
    Set objRcdSet = CreateObject("ADODB.Recordset")    


     objAdoCon.Open "Provider = Microsoft.Jet.oledb.4.0;Data Source = C:\Database1.mdb" 
     objRcdSet.Open "Write ur Query Here", objAdoCon

     ThisWorkbook.Worksheets("Sheet1").Range("A1").CopyFromRecordset objRcdSet

    Set objAdoCon = Nothing
    Set objRcdSet = Nothing

End Sub
于 2013-06-20T11:30:06.140 回答
2

我做了更多的研究和测试，并能够让自己摆脱这个困境。使用该CopyFromRecordset方法时excel会挂起的原因是因为我试图一次引入超过65,000条记录。显然，当记录限制从 65,000 条增加到 1,000,000 条记录时，MS Access 并没有跟随 excel。

我为解决方法所做的是打开查询并使用循环一次检索较小的记录块（<=65,000）。对我有用的代码如下所示。

Dim daoDB As DAO.Database
Dim daoQueryDef As DAO.QueryDef
Dim daoRcd As DAO.Recordset
Dim daoFld As DAO.Field
Dim i As Integer 'number to track field position
Dim j As LongPtr 'number to track record position (>32,767; cannot be integer)
Dim k As LongPtr 'represents retrieval limit of CopyFromRecordSet method

'notify user of progress
Application.StatusBar = False
Application.StatusBar = "opening query..."

'set up database connection and authentication for query
Set daoDB = OpenDatabase("C:\myFile.mdb")

strConnect = daoDB.QueryDefs("myQuery").Connect _
& "DSN=myDsn;USERNAME=myName;PWD=myPass "
Set daoDB2 = OpenDatabase("", False, False, strConnect)
daoDB2.Close
Set daoDB2 = Nothing

'open the desired query and recordset
Set daoQueryDef = daoDB.QueryDefs("myQuery")
Set daoRcd = daoQueryDef.OpenRecordset(dbOpenSnapshot, dbReadOnly)

'set up the fields in excel
i = 0
With Range("A1")
    For Each daoFld In daoRcd.Fields
    .Offset(0, i).Value = daoFld.Name
    i = i + 1
    Next daoFld
End With

'set up counters and perform record import while updating the user
j = 2
k = 30000
Application.StatusBar = False
Application.StatusBar = "importing... 0"

Do While Not daoRcd.EOF
    ThisWorkbook.Worksheets("Sheet1").Range("A" & j).CopyFromRecordset _
    daoRcd, k
    j = j + k
    Application.StatusBar = False
    Application.StatusBar = "importing... " & j

    'if end of file is reached, end the loop, otherwise continue importing
    If daoRcd.EOF = True Then
    Else
        daoRcd.MoveNext
    End If
Loop

'close the remaining connections
Application.StatusBar = False
daoRcd.Close
daoDB.Close
Set daoRcd = Nothing
Set daoDB = Nothing

Range("A1").Select

我想指出我在代码构建中遇到的一些事情：

  1. 该OpenRecordset方法中的 dbOpenSnapshot 选项很重要，因为其他选项（例如 dbOpenDynamic）可能会使运行时间增加一倍以上，具体取决于操作的数量。
  2. 如果将在 64 位环境中使用此宏，则可能必须对其进行修改。
  3. 该CopyFromRecordset方法不会自动带回字段标题，因此我预先添加了一个循环来执行此操作。
  4. 如果该过程是否完成，该CopyFromRecordset方法不会向用户提供任何指示，因此我使用该Application.StatusBar属性添加了期间状态栏消息。
  5. 即使到达文件末尾时循环停止，但在下一次循环迭代开始之前导入最后一条记录时，我仍然遇到运行时错误，因此我在循环结束。

总之，此代码允许我在尝试导入其源受保护的 Access 查询时有效地阻止 MS Access 给我登录提示。这与 .mdb 文件本身（可以在文件的连接字符串中指定）中找到的保护不同。

于 2013-07-22T04:35:53.363 回答