Excel 使用vba更改odbc连接的commandText时出现问题

我花了两天时间寻找解决方案，这让我发疯

首先让我解释一下我在做什么。我们带来了50万条记录，这些记录驱动了十几个数据透视表。为了保持工作簿的可管理文件大小，我直接从外部数据连接构建了pivot表。这是我手动配置的odbc连接

这一切都很好，我可以点击工作簿中的“全部刷新”，所有数据透视表都会自动更新，太棒了

但现在我需要能够用手动开始和结束日期限制整个记录集。。。更改数据透视表上的日期筛选器并不理想，因为它不仅仅是受结束日期影响的单个字段，还有一些字段需要在数据透视之前进行计算，这些字段的值取决于涉及结束日期的公式

在一整个下午反复破坏Excel之后，我发现了一个限制，即如果您的连接直接连接到数据透视表，那么您不能使用？在“参数”对话框中指向单元格引用时，一旦关闭书本，单元格引用将丢失

所以我的下一个方法是这样做：

Dim ReportStartDate, ReportEndDate

' Get parameters from Intro sheet
ReportStartDate = "'" & ActiveWorkbook.Worksheets("Intro").Range("$B$1").Value & "'"
ReportEndDate = "'" & ActiveWorkbook.Worksheets("Intro").Range("$B$2").Value & "'"

' There are 3 directpivot odbc connections/caches that need to be modified.
' In each query, the default report-end-date is specified by CURDATE().
' The default report-start-date is specified as '2010-01-01'
' Replace these defaults with the values retrieved above.

Dim cn As WorkbookConnection
Dim odbcCn As ODBCConnection
Dim originalsqltext, newsqltext

For Each cn In ThisWorkbook.Connections     ' loop through the connections
    If cn.Type = xlConnectionTypeODBC Then
        Set odbcCn = cn.ODBCConnection
        originalsqltext = odbcCn.CommandText
        If odbcCn.Parent = "Calls" Then
            newsqltext = Replace(originalsqltext, "CURDATE()", ReportEndDate)
            newsqltext = Replace(newsqltext, "'2010-01-01'", ReportStartDate)
        ElseIf odbcCn.Parent = "Suboutcomes" Then
            newsqltext = Replace(originalsqltext, "CURDATE()", ReportEndDate)
            newsqltext = Replace(newsqltext, "'2010-01-01'", ReportStartDate)
        ElseIf odbcCn.Parent = "QtyCallsPerDay1" Then
            newsqltext = Replace(originalsqltext, "CURDATE()", ReportEndDate)
        Else
            newsqltext = originalsqltext
        End If
        odbcCn.CommandText = newsqltext
        odbcCn.Refresh
        odbcCn.CommandText = originalsqltext
    End If
    cn.Refresh ' refresh the other connection without modification
Next
Set cn = Nothing
Set odbcCn = Nothing

但是当它到达odbcCn.CommandText=newsqltext时，它会给我一个错误 运行时错误'1004: 应用程序定义或对象定义错误。 这太没用了

我验证了newsqltext包含了我想要的内容，但它不会分配回CommandText

在又一天的谷歌搜索和一些简单的宏记录实验之后，改变CommandText似乎需要像

.CommandText = Array( _
"SELECT C1.CALLID, C1.TAKENON, C1A.TAKENAT, CAST(CONCAT(DATE_FORMAT(TAKENON,'%c/%e/%y'),' ',TIME_FORMAT(TAKENAT,'%H:" _
    , _
    "%i:%s')) AS CHAR) AS CallDateTime, YEAR(C1.TAKENON) AS Year, CEILING(MONTH(C1.TAKENON)/3) AS Quarter, MONTH(C1.TAKE" _
    , _

（剩下的我就不说了，因为它太大了）。。。起初，我认为这是我的问题，因为当我最初尝试录制宏时，我遇到了一个“太多行连续”错误，所以我尽可能缩短查询，在替换之前将其减少到1428个字符。替换后，它最终达到1448个字符。。。但是如何将其解析为代码所需的数组格式呢？还是有更好的方法

我真的不想像这样破坏我的查询，只是为了能够用vba编辑它们，我觉得我只是缺少了一些关于如何修改CommandText的东西

在我的搜索中发现了一些令人不安的事情，比如这个问题：无法更改odbc连接上的CommandText，除非您先将其更改为oledb，然后您可以更改CommandText，然后将连接更改回odbc。。。但那是在Excel 2010之前，它不再使用这些

在那里链接到的KnowledgeBase文章更令人震惊。。。当我看到StringToArray函数时，我以为我找到了一个解决方案，但后来我进一步阅读并看到了

注意：如果使用共享数据透视缓存、基于OLAP的数据透视表或基于多个合并范围的数据透视表连接到数据库，则前面的代码可能无法正常工作

然后

如果工作表上的多个数据透视表是从同一数据透视表派生的，则子例程在处理第一个数据透视表后将不工作。截至2003年3月，没有已知的解决此问题的方法

尽管它注意到这篇文章只适用于Excel2000到2003

还有一件事我试过了，我想也许我可以用一下？参数，然后用vba设置它们。。。但是，当我创建了一个带有参数的简单查询，然后记录了一个宏，同时我将参数指向新的单元格引用时，该宏只包含以下内容： 子参数5（） ' '参数5宏 "

我尝试使用direct-into-pivot类型的连接，以及连接到外部数据源的常规表（我知道它支持参数）

所以。。。有人知道为共享数据透视缓存odbc连接参数化查询的正确方法吗

更新： 我试过这个：

Dim cn, originalCn, newCn As WorkbookConnection
Dim odbcCn As ODBCConnection
Dim originalsqltext, newsqltext
Dim connStr As String

For Each cn In ThisWorkbook.Connections     ' loop through the connections
    If cn.Type = xlConnectionTypeODBC Then
        Set odbcCn = cn.ODBCConnection
        originalsqltext = odbcCn.CommandText
        Set originalCn = cn
        connStr = odbcCn.Connection
        Select Case odbcCn.Parent
            Case "Calls", "Suboutcomes"
                newsqltext = Replace(originalsqltext, "CURDATE()", ReportEndDate)
                newsqltext = Replace(newsqltext, "'2010-01-01'", ReportStartDate)
            Case "QtyCallsPerDay1"
                newsqltext = Replace(originalsqltext, "CURDATE()", ReportEndDate)
            Case Else
                newsqltext = originalsqltext
        End Select
        Set newCn = ActiveWorkbook.Connections.Add(odbcCn.Parent & "New", "WhoCares", connStr, newsqltext)
        Set cn = newCn
        cn.Refresh
        Set cn = originalCn
        newCn.Delete
    Else
        cn.Refresh ' refresh any other connections without modification
    End If
Next

Set cn = Nothing
Set odbcCn = Nothing
Set newCn = Nothing
Set originalCn = Nothing

虽然cn.Refresh似乎在让commandtext变成我想要的方面做了我想做的事情，但当我逐步完成时，它什么也做不了。如果它正在刷新，但我的数据透视没有更新，我可以看到它们可能在哪里查找调用1，在刷新发生时，它被命名为Calls1New，但连接没有做任何事情（查询通常需要几分钟才能完成）。或者我无法将其分配给同名的现有连接？在我设置cn=newCn之后，它们看起来完全相同，名称相同

我会再找一些，但如果有人做过类似的事情，我会感谢更多的帮助。非常感谢你迄今为止所付出的一切

编辑：所以我回到了原始状态

odbcCn.CommandText = newsqltext
cn.Refresh
odbcCn.CommandText = originalsqltext

我也试过了 odbcCn.CommandText=StringToArray（newsqltext） cn.刷新 odbcCn.CommandText=StringToArray（originalsqltext） 那是我在。两个人都没有工作

我将发布originalsqltext和newsql文本，因为它们就在错误之前。注意，如果我手动将originalsqltext粘贴到查询的对话框中，与newsqltext一样，originalsqltext也可以正常工作

**由于新信息，已删除以前的编辑**

注意-我发现了一个类似问题的线程-因为我已经测试过试图分配odbcCn.CommandText=originalsqltext（它没有以任何方式被更改），但它也失败了。然而，这个线程是从2009年开始的，所以它很可能不使用Excel2010，因为我试图编写

For Each pvtC In ThisWorkbook.PivotCaches
    name = pvtC.WorkbookConnection.name
    originalsqltext = pvtC.CommandText
    pvtC.CommandText = originalsqltext
Next

它在pvtC.CommandText=originalsqltext时也会失败

更新： 我现在确定这与查询本身无关，而是多个数据透视表指向同一数据透视缓存的条件。 我用简单的查询创建了一个新的外部数据源

SELECT * FROM clientdashboard1.Calls1 WHERE TAKENON BETWEEN '2010-01-01' AND CURDATE()

作为它的疑问。我将连接命名为AlphaTest，并从中创建了一个数据透视表，然后将该数据透视表复制到另一个表中，并使用不同的字段。

SELECT * FROM clientdashboard1.Calls1 WHERE TAKENON BETWEEN '2010-01-01' AND CURDATE()

For Each pvtC In ThisWorkbook.PivotCaches
    name = pvtC.WorkbookConnection.name
    If name = "AlphaTest" Then
        originalsqltext = pvtC.CommandText
        pvtC.CommandText = originalsqltext
    End If
Next

For Each cn In ThisWorkbook.Connections     ' loop through the connections
    If cn.Type = xlConnectionTypeODBC Then
        Set odbcCn = cn.ODBCConnection
        originalsqltext = odbcCn.CommandText
        Select Case odbcCn.Parent
            Case "Calls", "Suboutcomes"
                newsqltext = Replace(originalsqltext, "CURDATE()", ReportEndDate)
                newsqltext = Replace(newsqltext, "'2010-01-01'", ReportStartDate)
            Case "QtyCallsPerDay1"
                newsqltext = Replace(originalsqltext, "CURDATE()", ReportEndDate)
            Case Else
                newsqltext = originalsqltext
        End Select
        odbcCn.CommandText = newsqltext
        odbcCn.Refresh
        odbcCn.CommandText = originalsqltext
    Else ''' this used to be End If
        cn.Refresh ' refresh the other connection without modification
    End If
Next

somevar = "line 1" & _
          "line 2" & _
          .....
          "line 55"
somevar = somevar & _
          "line 56" & _
          "line 57"

ActiveWorkbook.Connections("ExampleConnection").Refresh

ActiveWorkbook.Connections("ExampleConnection").ODBCConnection.CommandText = _
"SELECT FILE1.FIELD1 AS ""Name1"", FILE1.FIELD2 as ""Name2""" & chr(13) & "" & chr(10) & chr(13) & "" & chr(10) & _
"FROM SERVER.LIBRARY.FILE1 FILE1" & chr(13) & "" & chr(10) & chr(13) & "" & chr(10) & _
"WHERE FILE1.FIELD1 = 'FILTER'"
ActiveWorkbook.Connections("ExampleConnection").Refresh

DIM str AS STRING

str = "VARIABLE"

ActiveWorkbook.Connections("ExampleConnection").ODBCConnection.CommandText = _
"SELECT FILE1.FIELD1 AS ""Name1"", FILE1.FIELD2 as ""Name2""" & chr(13) & "" & chr(10) & chr(13) & "" & chr(10) & _
"FROM SERVER.LIBRARY.FILE1 FILE1" & chr(13) & "" & chr(10) & chr(13) & "" & chr(10) & _
"WHERE FILE1.FIELD1 = '" & str & "'"
ActiveWorkbook.Connections("ExampleConnection").Refresh

ActiveWorkbook.Connections("ExampleConnection").Refresh
Sheet1.PivotTables("PivotTable1").PivotCache.Refresh
Sheet1.PivotTables("PivotTable2").PivotCache.Refresh
Sheet2.PivotTables("PivotTable1").PivotCache.Refresh
Sheet2.PivotTables("PivotTable2").PivotCache.Refresh

DIM s AS STRING
DIM f AS STRING
DIM w AS STRING
DIM r AS RANGE
Dim str AS STRING

set r = Sheet1.Range("A1")
str = r.Value
s = "SELECT FILE1.FIELD1 as ""Name1"", FILE1.FIELD2 as ""Name2"""
f = "FROM SERVER.LIBRARY.FILE1 FILE1"

If r.Value = "" Then
   w = ""
Else
   w = "WHERE FILE1.FIELD1 = '" & str & "'"
End If

ActiveWorkbook.Connections("ExampleConnection").ODBCConnection.CommandText = _
s & chr(13) & "" & chr(10) & chr(13) & "" & chr(10) & _
f & chr(13) & "" & chr(10) & chr(13) & "" & chr(10) & _
w
ActiveWorkbook.Connections("ExampleConnection").Refresh

Option Explicit

Sub UpdateWorkbookConnection(WorkbookConnectionObject As WorkbookConnection, Optional ByVal CommandText As String = "", Optional ByVal ConnectionString As String = "")

With WorkbookConnectionObject
    If .Type = xlConnectionTypeODBC Then
        If CommandText = "" Then CommandText = .ODBCConnection.CommandText
        If ConnectionString = "" Then ConnectionString = .ODBCConnection.Connection
        .ODBCConnection.Connection = Replace(.ODBCConnection.Connection, "ODBC;", "OLEDB;", 1, 1, vbTextCompare)
    ElseIf .Type = xlConnectionTypeOLEDB Then
        If CommandText = "" Then CommandText = .OLEDBConnection.CommandText
        If ConnectionString = "" Then ConnectionString = .OLEDBConnection.Connection
    Else
        MsgBox "Invalid connection object sent to UpdateWorkbookConnection function!", vbCritical, "Update Error"
        Exit Sub
    End If
    If StrComp(.OLEDBConnection.CommandText, CommandText, vbTextCompare) <> 0 Then
        .OLEDBConnection.CommandText = CommandText
    End If
    If StrComp(.OLEDBConnection.Connection, ConnectionString, vbTextCompare) <> 0 Then
        .OLEDBConnection.Connection = ConnectionString
    End If
    .Refresh
End With

End Sub

UpdateWorkbookConnection ActiveWorkbook.Connections("Connection"), "exec sp_MyAwesomeProcedure"

WorkbookConnection wc = book.Connections.Add("SQL-STRING", "", response.ConnectionString, response.SqlString, XlCmdType.xlCmdSql);
pivot = worksheet.PivotTables(1);
pivot.ChangeConnection(wc);