J
Job
The error is application-defined or object-defined error. Not sure why this
doesn't work. I can get the ptc.Connection to change, but not the .SQL
statement.
Sub ChangeSource()
'Declare our variables.
Dim ptc As PivotCache, oldSrv, newSrv,oldSQL ,newSQL As String
sFilename = Application.GetOpenFilename(, , "Input the name of the
new server or file path which you want the Pivot Table to point to.")
'They have cancelled.
If sFilename = "False" Then Exit Sub
newSrv = "ODBC;DSN=MS Access Database;DBQ=" & sFilename & ";DefaultDir=" &
sFilename & ";DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
oldSrv = pt.PivotCache.Connection
'Replace the ODBC information of whatever PivotTable
'is currently active.
Set ptc = pt.PivotCache
oldSQL = Left(Mid(ptc.Sql, Application.Find("`", ptc.Sql) + 1, 255),
Application.Find("`", Mid(ptc.Sql, Application.Find("`", ptc.Sql) + 1,
255)) - 1)
newSQL = Application.Substitute(ptc.Sql, oldSQL, sFilename)
ptc.Connection = Application.Substitute(ptc.Connection, oldSrv, newSrv)
' ====> This is error line
ptc.Sql = Application.Substitute(ptc.Sql, ptc.Sql, newSQL)
'====>
Next pt
Next ws
End Sub
doesn't work. I can get the ptc.Connection to change, but not the .SQL
statement.
Sub ChangeSource()
'Declare our variables.
Dim ptc As PivotCache, oldSrv, newSrv,oldSQL ,newSQL As String
sFilename = Application.GetOpenFilename(, , "Input the name of the
new server or file path which you want the Pivot Table to point to.")
'They have cancelled.
If sFilename = "False" Then Exit Sub
newSrv = "ODBC;DSN=MS Access Database;DBQ=" & sFilename & ";DefaultDir=" &
sFilename & ";DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
oldSrv = pt.PivotCache.Connection
'Replace the ODBC information of whatever PivotTable
'is currently active.
Set ptc = pt.PivotCache
oldSQL = Left(Mid(ptc.Sql, Application.Find("`", ptc.Sql) + 1, 255),
Application.Find("`", Mid(ptc.Sql, Application.Find("`", ptc.Sql) + 1,
255)) - 1)
newSQL = Application.Substitute(ptc.Sql, oldSQL, sFilename)
ptc.Connection = Application.Substitute(ptc.Connection, oldSrv, newSrv)
' ====> This is error line
ptc.Sql = Application.Substitute(ptc.Sql, ptc.Sql, newSQL)
'====>
Next pt
Next ws
End Sub