Created Unassigned: Posting VBA version here [63563]

Here is my port of code to VBA. Please move to the appropriate place on the site.

I use this in Excel 2013. I could not get the "ActiveWorkbook.Connections.Add2" code to work reliably and haven't had time to debug it further. In the current state, I believe the only impact is that if you add a new column to a table while the refresh is off, it might not show up until you find a manual way to trigger the right refresh. You will not get any error messages when executing the code, but the "Debug.Print" statement will log the error to the Immediate Window.

We implemented this in an Add-in and with a button on the ribbon.

```
Option Explicit

Private Const TEMP_MODEL_FLAT_FILE_CONNECTION_NAME As String = "OLAP PivotTable Extensions Temp Connection"

Sub ToggleAutoRefresh()
'Ported to VBA
'From v0.84 at <https://olappivottableextend.svn.codeplex.com/svn/OlapPivotTableExtensions/Connect.cs>
Dim bEnableRefresh As Boolean 'current state of refresh
Dim connTemp As WorkbookConnection 'dummy connection used to drive a refresh
Dim sTempDir As String 'temp directory eg. C:\Users\username\AppData\Local\Temp\
Dim sFile As String 'path and filename where we will store conn info
Dim i As Integer 'loop counter
Dim OriginalCalculationMode As Variant

On Error Resume Next
bEnableRefresh = ActiveWorkbook.PivotCaches(1).EnableRefresh
If Err Then
Select Case Err.Number
Case 9:
MsgBox "No PivotTables found.", vbCritical, "Error: " & Err.Number & " " & Err.Description
Case 91:
MsgBox "Active Workbook not found.", vbCritical, "Error: " & Err.Number & " " & Err.Description
Case Else
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
End Select
Exit Sub
End If
On Error GoTo 0

If bEnableRefresh Then
Application.StatusBar = "Setting PowerPivot refresh off..."
Else
Application.StatusBar = "Setting PowerPivot refresh on..."
End If

Set connTemp = Nothing
If Not bEnableRefresh Then 'let's start refreshing
'if we are about to re-enable refresh, make a quick model change (adding a simple flat file connection
'which we will delete in a second... deleting it will cause the pivots to refresh)
sTempDir = Environ$("Temp") & "\"
sFile = sTempDir & TEMP_MODEL_FLAT_FILE_CONNECTION_NAME & ".txt"
Open sFile For Output As #1
Print #1, "col1" & vbCrLf & "1" 'just some sample contents to load
Close #1
For i = 1 To Application.ActiveWorkbook.Connections.Count
If Application.ActiveWorkbook.Connections(i).Name = TEMP_MODEL_FLAT_FILE_CONNECTION_NAME Then
Set connTemp = Application.ActiveWorkbook.Connections(i)
Exit For
End If
Next i
If connTemp Is Nothing Then
'Any suggestions on how to fix this connection string? I can't get it working reliably...
On Error Resume Next
connTemp = ActiveWorkbook.Connections.Add2( _
Name:=TEMP_MODEL_FLAT_FILE_CONNECTION_NAME, _
Description:="This is a temporary connection used by OLAP PivotTable Extensions to trigger a quick refresh of " & _
"the PivotTable field list. Feel free to delete.", _
ConnectionString:="OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sTempDir & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited"";", _
CommandText:="OLAP PivotTable Extensions Temp Connection.txt", _
lCmdType:=Excel.XlCmdType.xlCmdTable, _
CreateModelConnection:=True, _
ImportRelationships:=False)
If Err Then Debug.Print Err.Number & ":" & Err.Description
On Error GoTo 0
End If
End If

'enable/disable PivotCaches
For i = 1 To Application.ActiveWorkbook.PivotCaches.Count
If PivotCacheIsDataModel(Application.ActiveWorkbook.PivotCaches(i)) Then
If bEnableRefresh Then
Application.ActiveWorkbook.PivotCaches(i).EnableRefresh = False
Else
Application.ActiveWorkbook.PivotCaches(i).EnableRefresh = True
End If
End If
Next i

'enable/disable DAX query tables
For i = 1 To Application.ActiveWorkbook.Connections.Count
If Application.ActiveWorkbook.Connections(i).Type = xlConnectionTypeMODEL Then
On Error Resume Next
'this statement will fail for the ThisWorkbookDataModel connection
'but will succeed for DAX query tables...
'if we want to avoid this error in the future, we may have to check
'whether ModelConnection.CommandType = xlCmdCube
'(which means it's ThisWorkbookDataModel) or
'ModelConnection.CommandType = xlCmdDAX (or maybe xlCmdTable, too?)
'which means it's a DAX query table
Application.ActiveWorkbook.Connections(i).OLEDBConnection.EnableRefresh = Not bEnableRefresh
On Error GoTo 0
End If
Next i

'set the calculation mode to manual when disabling auto refresh so that CUBEVALUE formulas don't refresh
If bEnableRefresh Then
'save the current calculation mode before setting it to manual
OriginalCalculationMode = Application.Calculation
End If
If Not bEnableRefresh Then
Application.Calculation = xlCalculationAutomatic
'delete the temporary flat file connection to trigger a refresh of the
'field list in the PivotTables without refreshing the SQL data sources
On Error Resume Next
connTemp.Delete
On Error GoTo 0
ActiveWorkbook.Model.Refresh
Else
Application.Calculation = xlCalculationManual
End If

If bEnableRefresh Then
Application.StatusBar = ActiveWorkbook.Name & " PowerPivot Refresh = OFF"
Else
Application.StatusBar = ActiveWorkbook.Name & " PowerPivot Refresh = ON"
End If

End Sub

Function PivotCacheIsDataModel(pc As PivotCache) As Boolean
PivotCacheIsDataModel = pc.OLAP And _
pc.WorkbookConnection.Type = xlConnectionTypeMODEL
'pc.WorkbookConnection <> Nothing And
End Function
```