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

Question

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

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

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

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

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

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

如果我首先打开Entry表单，然后再次显示Excel的不同实例，则只会显示Display的只读副本。

只有当两个文件都在Excel的单个实例中时才会出现只读的时间，这不是我想要的。

EDIT2：

有关详细信息，请参阅此处使用的SQL（共4页）

SQL1 - 从EntryTable中选择*

SQL2 - 从摘要1中选择A。*，[日期+时间]左连接（从[摘要]中选择[Die No]，选择[Die No]，最多（日期+时间）作为[日期+时间]] [Die No] B A. [Die No] = B. [Die No]

SQL3 - 从Summary2中选择*，其中[Date + Time] = Date + Time

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

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

更新：我的同事已经在她的电脑上对系统进行了测试，没有测试过任何问题。我被告知最有可能是我的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

编辑： 我不确定你的＆＃34; 1st＆＃34;源工作簿的位置，所以让我们尝试插入我在下面评论的行

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

如果仍然无效，请在单元格B9中发布您的SQL和工作簿名称。

编辑2： 如果更改FROM子句，结果如下：

   select * from [EntryTable$]

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