ADODB 连接 - 标题文本未提取和只读问题

Posted 2023-04-19

【中文标题】ADODB 连接 - 标题文本未提取和只读问题

【英文标题】：ADODB Connection - Header text not extracted & read-only issue

【发布时间】：2018-01-31 21:38:49

【问题描述】：

我正在深入研究 VBA 数据连接的世界，希望能得到一些帮助。下面的代码是我到目前为止所拥有的，但有一些我无法弄清楚的奇怪之处。

Sub sbADO()
    Dim sSQLQry As String
    Dim ReturnArray
    Dim Conn As New ADODB.Connection
    Dim mrs As New ADODB.Recordset
    Dim DBPath As String, sconnect As String

    DBPath = "C:\USERS\NAME\DOCUMENTS\VBA Work\Data Source.xlsx"
    sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
    Conn.Open sconnect

    sSQLQry = "SELECT * From [Sheet1$]"
    mrs.Open sSQLQry, Conn
    Sheet3.Range("A1").CopyFromRecordset mrs
    mrs.Close
    Conn.Close
End Sub

但是，此代码有效：

拉入的数据不包括数据集的第1行（因此不拉入标题） 如果源工作簿“Data Source.xlsx”已打开。该代码将导致工作簿再次打开，但处于只读模式。这可以避免吗？ 可以编辑连接字符串以使源文件永远不会被锁定吗？ IE。在只读模式下查询其他用户可以在查询完成时打开它吗？

感谢任何帮助 谢谢 卡利科

【问题讨论】：

架构元数据从不成为结果集的一部分。迭代Fields 集合。

以只读模式打开工作簿有什么问题？该文件已被另一个进程/用户锁定以进行编辑 - 您无法获取它的写锁定。你不是在阅读吗？如果在连接字符串中指定Mode=read;，它还会弹出消息吗？

@Mat'sMug 感谢您的回复。好吧，我对处理记录集和连接字符串很陌生。这里有两个问题。如果我在执行此行Conn.Open sconnect 后暂停代码，然后尝试打开源文件Data Source.xlsx 我收到File is Locked by Another User 警告消息。这是不可取的，因为网络上有很多人需要对该源文件的写入权限。如果有人已经将文件锁定为Read-only，则不必太担心第二个实例被打开，因为我可以在之后使用 VBA 关闭它。

响应您的编辑。我尝试将 conn 字符串更改为 sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';Mode=Read;ReadOnly=True;"，但仍然遇到在执行查询时锁定此文件的相同问题。

Set mrs = Nothing 和 Set Conn = Nothing 在你关闭它们之后，应该把最后的钉子放在这些对象的棺材里。 TBH 最好的解决方案是将数据放在它所属的位置：在数据库中。即使是 MS-Access 也可以。

【参考方案1】：

试试这个：

Sub sbADO()
  Dim sSQLQry As String
  Dim ReturnArray
  Dim Conn As New ADODB.Connection
  Dim mrs As New ADODB.Recordset
  Dim DBPath As String, sconnect As String,i as integer

  'DBPath = ThisWorkbook.FullName
  DBPath = "C:\USERS\NAME\DOCUMENTS\VBA Work\Data Source.xlsx"
  sconnect= "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=""" & _
     DBPath & """;Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX = 1"""

  Conn.Open sconnect

  sSQLQry = "SELECT * From [Sheet1$]"
  mrs.Open sSQLQry, Conn
  if rs.recordcount>0 then 
     rs.movefirst
     for i=0 to rs.fields.count-1
       'read here the headers and add them to your sheet in row 1
       Sheet3.Cells(1, i + 1) =rs.Fields(i).Name
     next
  end if
  Sheet3.Range("A2").CopyFromRecordset mrs
  mrs.Close
  Conn.Close
End Sub