如何正确地从 Excel 工作表的 VBA 连接到另一个 Excel 工作表？

Question

我目前有 2 个单独的 Excel 工作表。一个是数据输入，另一个是显示。

显示器使用VBA连接数据输入获取数据。通常，它的功能足够好。但是，我需要将 2 个工作表放在单独的窗口中，这意味着它们可以在同一屏幕上的不同窗口中同时显示。

这种情况下的问题是，当我在显示中单击执行以开始 SQL 查询时，显示窗口会打开另一个数据输入工作表（只读）并读取它而不是我最初打开的那个。这个问题是因为我的连接字符串还是我的 ADODB.Recordset 有问题？

这里是包含连接字符串和 ADODB.Recordset 的 sub。 编辑：包含完整代码以为需要它的人提供完整的上下文。

Public Sub QueryWorksheet(szSQL As String, rgStart As Range, wbWorkBook As String, AB As String)
Dim rsData As ADODB.Recordset
Dim szConnect As String
On Error GoTo ErrHandler

If AB = "1st" Then
wbWorkBook = ThisWorkbook.Sheets("Inner Workings").Range("B9").Text
End If

Application.StatusBar = "Retrieving data ....."
'Set up the connection string to excel - thisworkbook
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & wbWorkBook & ";" & _
            "Extended Properties=Excel 8.0;"

Set rsData = New ADODB.Recordset
'Run the query as adCmdText
rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText

'Check if data is returned
If Not rsData.EOF Then
    'if the recordset contains data put them on the worksheet
    rgStart.CopyFromRecordset rsData
Else

End If
'Close connection
rsData.Close
'Clean up and get out
Set rsData = Nothing
Application.StatusBar = False
Exit Sub

ErrHandler:
'an error occured in the SQL-statement
MsgBox "Your query could not be executed, the SQL-statement is incorrect."
Set rsData = Nothing
Application.StatusBar = False

End Sub

Sub process()
Call clear
Call testsql("1st")  ' populate 1st Summary
Call testsql("2nd")  ' find Date+Time
Call testsql("3rd")  ' arrange record by newest
Call testsql("4th")  ' show final results
End Sub

Sub testsql(AB As String)

Dim rgPlaceOutput As Range    'first cell for the output of the query
Dim stSQLstring As String     'text of the cell containing the SQL statement
Dim rg As String, SQL As String

If AB = "1st" Then
stSQLstring = ThisWorkbook.Sheets("Inner Workings").Range("B2").Text
Set rgPlaceOutput = ThisWorkbook.Sheets("1st Summary").Range("A2")
End If
If AB = "2nd" Then
stSQLstring = ThisWorkbook.Sheets("Inner Workings").Range("B3").Text
Set rgPlaceOutput = ThisWorkbook.Sheets("2nd Summary").Range("A2")
End If
If AB = "3rd" Then
stSQLstring = ThisWorkbook.Sheets("Inner Workings").Range("B4").Text
Set rgPlaceOutput = ThisWorkbook.Sheets("3rd Summary").Range("A2")
End If
If AB = "4th" Then
stSQLstring = ThisWorkbook.Sheets("Inner Workings").Range("B5").Text
Set rgPlaceOutput = ThisWorkbook.Sheets("Final Summary").Range("A5")
End If

QueryWorksheet stSQLstring, rgPlaceOutput, ThisWorkbook.FullName, AB

End Sub

Sub clear()
ActiveWorkbook.Sheets("1st Summary").Range("A2:BR5000").Value = Empty
ActiveWorkbook.Sheets("2nd Summary").Range("A2:BR5000").Value = Empty
ActiveWorkbook.Sheets("3rd Summary").Range("A2:BR5000").Value = Empty
ActiveWorkbook.Sheets("Final Summary").Range("A5:BR5000").Value = Empty
End Sub

我还注意到另一件事。根据我首先打开的文件，当我单击执行时，它可能会导致两个文件都创建一个只读副本。如果我在不同的 Excel 实例中先打开 Display 然后打开 Entry 表单，它将创建两个文件的只读副本。

如果我先打开Entry form，然后再Display in，不同的Excel实例，只会出现Display的只读副本。

只读不出现的唯一情况是两个文件都在一个 Excel 实例中，这不是我想要的。

编辑2：

更多信息，这里是我使用的 SQL（共 4 个）

SQL1 - 从 EntryTable 中选择 *

SQL2 - select A.*,[Date + Time] from Summary1 A left join (select [Die No], max (Date + Time) as [Date + Time] from Summary1 group by [Die No]) B on A.[Die No] = B.[Die No]

SQL3 - 从 Summary2 中选择 * 其中 [日期 + 时间] = 日期 + 时间

SQL4 - 从 Summary3 中选择 Project_No、Die_No、Description、Repair_Details、Status

单元格 B9 中的工作簿名称 = V:\Die Maintenance System v2\Die Maintenance Menu.xlsx

更新：我的同事已经在她的 PC 上测试了系统并且测试没有问题。我被告知它最有可能是我的 Excel 设置。但是对于我的生活，我无法弄清楚是什么原因造成的。使用什么类型的设置来防止只读文件出现？

编辑：我可以看到这篇文章的发布时间太长了。我决定在新线程right here 上继续这个。

Answer 1

所以我会使用Workbook.Open() 方法。

Sub Example()
Dim wb as Workbook
Dim path as String

path = "C:\Users\User\Desktop\1.xlsx"

set wb = Workbook.Open(path) 
End Sub 

现在您可以使用wb 来执行每个vba 函数。然后有一个选项可以检查工作簿是否已经打开，请查看here。我不认为你可以用 adodb 做到这一点。

Answer 2

我厌倦了使用ACE，它工作得很好。它没有打开新文件。

szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & _
            wbWorkBook  & "';" & _
            "Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"

Answer 3

您的 SQL FROM 子句引用了不同的命名范围。请发布您的 SQL 文本。它必须有资格更正命名范围或工作表名称。

    SELECT Project No, Die No, Description, Repair Details, Status
    FROM DATA1  <- correct this to qualified named range or sheet name

喜欢

   FROM [Entry Form$] 'or

   FROM [Named Range] <- this can be found in Formulas | Name Manager

编辑： 我不确定您的“第一个”源工作簿的位置，所以让我们尝试插入我在下面评论的行

   wbWorkBook = ThisWorkbook.Sheets("Inner Workings").Range("B9").Text
   wbWorkBook = Workbooks(wbWorkbook).FullName  '<- add this line

如果还是不行，请在单元格 B9 中发布您的 SQL AND 工作簿名称。

编辑 2： 如果将 FROM 子句更改为：

   select * from [EntryTable$]

编辑 3：你有密码吗？如果是这样，请先尝试禁用它以将问题隔离为只读。