VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CFilesToModify"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'recieve list fo files, generate collection, using name as key with path
'public - file list
'public - collection of files/paths
'public - collection of olap connections
'public method - change connection
'public method(s) - additional
'    DeleteExistingCustomProperties
'    InsertReference_ActiveWorkbook mstrPath_XLA_Prod
'    InsertCode_ActiveWorkbook
'    TurnOffRefreshOnOpen

Private mcolSelectedFiles As Collection

Private mobjExcel As Excel.Application 'Object
Private mobjWorkbooks As Excel.Workbooks 'object

Private lngMacroSecurity_User As Long

Private mcolServerCubePairs As Collection
Private mstrConnection_OLAPServer As String
Private mstrConnection_OLAPCube As String
Private Const mstrConnection_Pivots = "OLEDB;Provider=MSOLAP.4;Integrated Security=SSPI;Persist Security Info=True;" & _
                    "User ID="""";Initial Catalog=CubeName;Data Source=ServerName;Location=ServerName;" & _
                    "MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error"
Private Const mstrConnection_Test = "Provider=MSOLAP;Initial Catalog=CubeName;Data Source=ServerName"
Private mstrConnection_Verified As String

Private mstrOutputFolderPath As String
Private mbolRefreshOnOpen As Boolean
Private mbolInsertCode As Boolean
Private mbolInsertXLAReference As Boolean
Private mbolDeleteCustomProperties As Boolean
Private mbolChangeConnection As Boolean
Private mbolSaveOnFinish As Boolean
Private mbolPagefieldsMulti As Boolean

Private mstrXLAPath As String
Const mstrName_XLA As String = "RefreshPivots_2003"

Private Sub Class_Initialize()
    
    Set mobjExcel = ThisWorkbook.Application
    Set mobjWorkbooks = mobjExcel.Workbooks
    mobjExcel.DisplayAlerts = False
        
    Set mcolSelectedFiles = New Collection
    Set mcolServerCubePairs = New Collection
    
    mbolRefreshOnOpen = False
    mbolInsertCode = False
    mbolInsertXLAReference = False
    mbolDeleteCustomProperties = False
    mbolChangeConnection = False
    mbolSaveOnFinish = False
    mbolPagefieldsMulti = False
    
End Sub

Private Sub Class_Terminate()

    If IsObject(mobjExcel) Then Set mobjExcel = Nothing
    
    If IsObject(mobjWorkbooks) Then Set mobjWorkbooks = Nothing
    
    If IsObject(mcolSelectedFiles) Then Set mcolSelectedFiles = Nothing
    If IsObject(mcolServerCubePairs) Then Set mcolSelectedFiles = Nothing

End Sub

Public Property Let XLAPath(val As String)

    If Len(Dir(val, vbNormal)) > 0 And _
        InStr(Right(val, 5), ".xl") Then

        mstrXLAPath = val
    
    End If
    
End Property

Public Property Get XLAPath() As String

    XLAPath = mstrXLAPath
    
End Property

Public Property Let DeleteCustomProperties(val As Boolean)

    mbolDeleteCustomProperties = val
    
End Property

Public Property Get DeleteCustomProperties() As Boolean

    DeleteCustomProperties = mbolDeleteCustomProperties
    
End Property

Public Property Let PagefieldsMulti(val As Boolean)

    mbolPagefieldsMulti = val
    
End Property

Public Property Get PagefieldsMulti() As Boolean

    PagefieldsMulti = mbolPagefieldsMulti
    
End Property

Public Property Let InsertXLAReference(val As Boolean)

    mbolInsertXLAReference = val
    
End Property

Public Property Get InsertXLAReference() As Boolean

    InsertXLAReference = mbolInsertXLAReference
    
End Property

Public Property Let InsertCode(val As Boolean)

    mbolInsertCode = val
    
End Property

Public Property Get InsertCode() As Boolean

    InsertCode = mbolInsertCode
    
End Property

Public Property Let RefreshOnOpen(val As Boolean)

    mbolRefreshOnOpen = val
    
End Property

Public Property Get RefreshOnOpen() As Boolean

    RefreshOnOpen = mbolRefreshOnOpen
    
End Property

Public Property Let SaveOnFinish(val As Boolean)

    mbolSaveOnFinish = val
    
End Property

Public Property Get SaveOnFinish() As Boolean

    SaveOnFinish = mbolSaveOnFinish
    
End Property

Public Property Let OutputFolder(val As String)

    mstrOutputFolderPath = val
    
End Property

Public Property Get OutputFolder() As String

    OutputFolder = mstrOutputFolderPath
    
End Property

Public Property Let OLAPServer(val As String)

    mstrConnection_OLAPServer = val
    
End Property

Public Property Get OLAPServer() As String

    OLAPServer = mstrConnection_OLAPServer
    
End Property

Public Property Let OLAPCube(val As String)

    mstrConnection_OLAPCube = val
    
End Property

Public Property Get OLAPCube() As String

    OLAPCube = mstrConnection_OLAPCube
    
End Property

Public Property Get CubeServerPairs() As Collection

    Set CubeServerPairs = mcolServerCubePairs

End Property

Public Property Let ChangeConnection(val As Boolean)

    mbolChangeConnection = val

End Property

Public Property Get ChangeConnection() As Boolean

    ChangeConnection = mbolChangeConnection

End Property

Public Property Let SelectedFiles(val As Variant)

    Dim strValuePair As String
    Dim varTempArray_Files As Variant
    Dim intCounter As Integer

    varTempArray_Files = Split(val, ";")
    
    If mcolSelectedFiles.Count > 0 Then
        For intCounter = 1 To mcolSelectedFiles.Count
            mobjWorkbooks(Dir(mcolSelectedFiles(1))).Close
            mcolSelectedFiles.Remove 1
        Next intCounter
    End If
    
    For intCounter = 0 To UBound(varTempArray_Files)
        
        mcolSelectedFiles.Add Key:=Dir(varTempArray_Files(intCounter), vbNormal), Item:=(varTempArray_Files(intCounter))
    
    Next intCounter
    
    OpenFiles
    
End Property

Public Property Get SelectedFiles() As Collection

    Set SelectedFiles = mcolSelectedFiles

End Property

Private Function DoCustomProperties() As Boolean

On Error GoTo ErrorTrap

    Dim objWorkbook As Workbook
    Dim Prop As Object
    Dim CProps As Object
    Dim intCounter As Integer
    
    If mbolDeleteCustomProperties = True Then
    
        For intCounter = 1 To mcolSelectedFiles.Count
        
            Set objWorkbook = mobjWorkbooks(Dir(mcolSelectedFiles(intCounter)))
            
            Set CProps = objWorkbook.CustomDocumentProperties
            
            For Each Prop In CProps
    
                Prop.Delete
    
            Next Prop
            
        Next intCounter

    End If
    
    DoCustomProperties = True
    
ExitSub:

    If IsObject(objWorkbook) Then Set objWorkbook = Nothing
    If IsObject(Prop) Then Set Prop = Nothing
    If IsObject(CProps) Then Set CProps = Nothing
    
    Exit Function
    
ErrorTrap:

    GoTo ExitSub
    
End Function

Private Function DoRefreshOnOpen() As Boolean

On Error GoTo ErrorTrap

    Dim objWorkbook As Workbook
    Dim pvtTable As PivotTable
    Dim wksPivots As Worksheet
    Dim intCounter As Integer
    
    For intCounter = 1 To mcolSelectedFiles.Count
    
        Set objWorkbook = mobjWorkbooks(Dir(mcolSelectedFiles(intCounter)))
        
        For Each wksPivots In objWorkbook.Worksheets
        
            For Each pvtTable In wksPivots.PivotTables
            
                pvtTable.PivotCache.RefreshOnFileOpen = mbolRefreshOnOpen
                
            Next pvtTable
            
        Next wksPivots
    
    Next intCounter
    
    DoRefreshOnOpen = True
    
ExitSub:

    If IsObject(objWorkbook) Then Set objWorkbook = Nothing
    If IsObject(wksPivots) Then Set wksPivots = Nothing
    If IsObject(pvtTable) Then Set pvtTable = Nothing
    
    Exit Function
    
ErrorTrap:

    GoTo ExitSub

End Function

Private Function DoCode() As Boolean

On Error GoTo ErrorTrap

    Dim vbProj As Object
    Dim VBComp As Object
    Dim CodeMod As Object
    Dim LineNum As Long
    Dim objWorkbook As Workbook
    Dim intCounter As Integer

    If mbolInsertCode = True Then
    
        For intCounter = 1 To mcolSelectedFiles.Count
        
            Set objWorkbook = mobjWorkbooks(Dir(mcolSelectedFiles(intCounter)))
    
            Set vbProj = objWorkbook.VBProject
            Set VBComp = vbProj.VBComponents("ThisWorkbook")
            Set CodeMod = VBComp.CodeModule
            
            With CodeMod
            
                'deletes all existing lines of code
                .DeleteLines 1, .CountOfLines
                
                
                
                'adds module level variabe sessions
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Option Explicit"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Const mstrName_XLA As String = ""RefreshPivots_2003"""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Dim mstrPath_XLASwitcher As String"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Const mstrPath_XLASwitcher_2003 As String = ""\\nzur0218dsq\Arisk Excel\ParameterizeExcelSheet\Addin\XLASwitcher_2003.txt"""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Const mstrPath_XLASwitcher_2007 As String = ""\\nzur0218dsq\Arisk Excel\ParameterizeExcelSheet\Addin\XLASwitcher_2007.txt"""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Private mstrPath_XLA As String"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Const mstrMessage_XLANotFound As String = ""XLA required for update is not available.  Pivot refresh can not proceed."""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Const mstrMessage_TrustToVBProject As String = ""Automated updates via the XLA will not run.  You need to enable programmatic access to the VBA Project."""
                
                'adds workbook open procedure
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Private Sub Workbook_Open()"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "On Error GoTo ErrorTrap"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Dim vbProj As Object"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Dim chkRef As Object"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Dim bolFound As Boolean"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Dim intFile As Integer"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Dim strXLA_CurrentPath As String"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Set vbProj = ThisWorkbook.VBProject"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    intFile = FreeFile"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    If ThisWorkbook.Application.Version = 12 Then"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "         mstrPath_XLASwitcher = mstrPath_XLASwitcher_2007"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Else"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "         mstrPath_XLASwitcher = mstrPath_XLASwitcher_2003"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    End If"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Open mstrPath_XLASwitcher For Input As #intFile"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Input #intFile, mstrPath_XLA"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    For Each chkRef In vbProj.References"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "        If chkRef.Name = mstrName_XLA Then"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "            bolFound = True"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "            Exit For"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "        End If"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Next"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    If bolFound = False Then"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "         vbProj.References.AddFromFile mstrPath_XLA"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    End If"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "     CallRefresh"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "ExitSub:"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    If IsObject(vbProj) Then Set vbProj = Nothing"
                .InsertLines LineNum, "    If IsObject(chkRef) Then Set chkRef = Nothing"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Exit Sub"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "ErrorTrap:"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    If Err.Number = ""1004"" Then"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "         MsgBox mstrMessage_TrustToVBProject, vbOKOnly, ""Refresh Pivots XLA"""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    Else"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "         MsgBox err.Description, vbOKOnly, ""Refresh Pivots XLA"""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    End If"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "    GoTo ExitSub"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "End Sub"
                
                'adds add'l procedure for refreshwrapper
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Private Sub CallRefresh()"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "     RefreshSheetPerParam ThisWorkbook"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "End Sub"
                
                'adds macro incase user needs to enable macros or enable trust to vbe
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "Public Sub RunUpdateViaXLA()"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "     Workbook_Open"
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, ""
                LineNum = .CountOfLines + 1
                .InsertLines LineNum, "End Sub"
                
            End With
        
        Next intCounter
        
    End If
    
    DoCode = True
    
ExitSub:

    If IsObject(vbProj) Then Set vbProj = Nothing
    If IsObject(VBComp) Then Set VBComp = Nothing
    If IsObject(CodeMod) Then Set CodeMod = Nothing
    If IsObject(objWorkbook) Then Set objWorkbook = Nothing
    
    Exit Function
    
ErrorTrap:

    GoTo ExitSub
      
End Function

Private Function DoSave() As Boolean

On Error GoTo ErrorTrap

    Dim strConnection As String
    Dim strConnection_Initial As String
    Dim objWorkbook As Workbook
    Dim pvcPivot As PivotCache
    Dim intCounter As Integer
    
    If mbolSaveOnFinish = True Then
            
        For intCounter = 1 To mcolSelectedFiles.Count
        
            Set objWorkbook = mobjWorkbooks(Dir(mcolSelectedFiles(intCounter)))
            
            objWorkbook.SaveAs mstrOutputFolderPath & objWorkbook.Name
        
        Next intCounter
    
    End If
    
    DoSave = True

ExitSub:

    If IsObject(pvcPivot) Then Set pvcPivot = Nothing
    
Exit Function

ErrorTrap:

    DoSave = False
    
    GoTo ExitSub

End Function

Private Function DoChangeConnections() As Boolean

On Error GoTo ErrorTrap

    Dim strConnection As String
    Dim strConnection_Initial As String
    Dim objWorkbook As Workbook
    Dim pvcPivot As PivotCache
    Dim intCounter As Integer
    
    If Len(mstrConnection_Verified) > 0 And mbolChangeConnection = True Then
            
        For intCounter = 1 To mcolSelectedFiles.Count
        
            Set objWorkbook = mobjWorkbooks(Dir(mcolSelectedFiles(intCounter)))
        
            For Each pvcPivot In objWorkbook.PivotCaches
            
                With pvcPivot
                
                    strConnection_Initial = .Connection
                    
                    .Connection = mstrConnection_Verified
                        
                    DoEvents
                    .Refresh
                
                End With
            
            Next pvcPivot
        
        Next intCounter
    
    End If
    
    DoChangeConnections = True

ExitSub:

    If IsObject(pvcPivot) Then Set pvcPivot = Nothing
    
Exit Function

ErrorTrap:

    DoChangeConnections = False
    
    GoTo ExitSub

End Function

Private Function DoXLAReference() As Boolean

On Error GoTo ErrorTrap

    Dim vbProj As Object
    Dim chkRef As Object
    Dim bolFound As Boolean
    Dim objWorkbook As Workbook
    Dim intCounter As Integer
    
        
    If mbolInsertXLAReference = True Then
    
        For intCounter = 1 To mcolSelectedFiles.Count
        
            Set objWorkbook = mobjWorkbooks(Dir(mcolSelectedFiles(intCounter)))
            Set vbProj = objWorkbook.VBProject
            
            For Each chkRef In vbProj.References
            
                If chkRef.Name = mstrName_XLA Then
                
                    'set flag to found
                    bolFound = True
                
                End If
            
            Next
            
            If bolFound = False Then
            
                vbProj.References.AddFromFile mstrXLAPath
            
            End If
        
        Next intCounter
        
    End If
    
    DoXLAReference = True
        
ExitSub:

    If IsObject(vbProj) Then Set vbProj = Nothing
    If IsObject(chkRef) Then Set chkRef = Nothing
    If IsObject(objWorkbook) Then Set objWorkbook = Nothing
    
    Exit Function
    
ErrorTrap:
    
    GoTo ExitSub
      
End Function

Private Function DoPageFieldsMulti()

On Error GoTo ErrorTrap

    Dim objWorkbook As Excel.Workbook
    Dim objWorksheet As Excel.Worksheet
    Dim pvtTemp As PivotTable
    Dim pvfTemp As PivotField
    Dim cubTemp As CubeField
    Dim strName_Temp As String
    Dim intCounter As Integer
    
    If mbolPagefieldsMulti = True Then
    
        For intCounter = 1 To mcolSelectedFiles.Count
        
            Set objWorkbook = mobjWorkbooks(Dir(mcolSelectedFiles(intCounter)))
        
            For Each objWorksheet In objWorkbook.Worksheets
            
                For Each pvtTemp In objWorksheet.PivotTables
                
                    For Each pvfTemp In pvtTemp.PageFields
                    
                        strName_Temp = pvfTemp.Name
                        
                        If pvfTemp.CubeField.EnableMultiplePageItems = False And _
                           InStr(pvfTemp.Name, "[Risk Measure]") = 0 Then
                            
                            pvtTemp.ManualUpdate = True
                            
                            On Error Resume Next
                            pvfTemp.CubeField.EnableMultiplePageItems = True
                            On Error GoTo ErrorTrap
                            
                        End If
                        
                    Next pvfTemp
                    
                Next pvtTemp
                
            Next objWorksheet
            
        Next intCounter
        
    End If
    
    DoPageFieldsMulti = True
    
ExitFunction:

    If IsObject(pvtTemp) Then Set pvtTemp = Nothing
    If IsObject(objWorkbook) Then Set objWorkbook = Nothing
    
    Exit Function
    
ErrorTrap:

    GoTo ExitFunction
    
End Function

Public Function WorkbboksStillOpen() As Boolean

On Error GoTo ErrorTrap

    If mcolSelectedFiles.Count > 0 Then
    
        WorkbboksStillOpen = True
        
    End If
        
ExitSub:

    Exit Function
    
ErrorTrap:
    
    GoTo ExitSub
      
End Function

Private Sub OpenFiles()

    Dim intCounter As Integer
    
    lngMacroSecurity_User = mobjExcel.AutomationSecurity
    mobjExcel.AutomationSecurity = msoAutomationSecurityLow
    
    For intCounter = 1 To mcolSelectedFiles.Count

        mobjWorkbooks.Open mcolSelectedFiles(intCounter)

    Next intCounter

    mobjExcel.AutomationSecurity = lngMacroSecurity_User
    
    Call RefreshCubeServerPairs
    
End Sub

Public Function RefreshCubeServerPairs() As Boolean

On Error GoTo ErrorTrap

    Dim objWorkbook As Excel.Workbook
    Dim pvtTemp As PivotCache
    Dim intCounter As Integer
    Dim intCounter_Conn As Integer
    
    Dim strConnections As String
    Dim varConnections As Variant
    Dim strTemp_Server As String
    Dim strTemp_Cube As String
    Dim strConnectionPair As String
    
    If mcolServerCubePairs.Count > 0 Then
        For intCounter = 1 To mcolServerCubePairs.Count
            mcolServerCubePairs.Remove 1
        Next intCounter
    End If
    
    For intCounter = 1 To mcolSelectedFiles.Count
        
        Set objWorkbook = mobjWorkbooks(Dir(mcolSelectedFiles(intCounter)))
    
        For Each pvtTemp In objWorkbook.PivotCaches
        
            strConnections = pvtTemp.Connection
            varConnections = Split(pvtTemp.Connection, ";")
            
            For intCounter_Conn = 0 To UBound(varConnections) - 1
            
                If Left(Trim(varConnections(intCounter_Conn)), 11) = "Data Source" Then
                
                    strTemp_Server = Trim(Mid(varConnections(intCounter_Conn), InStr(varConnections(intCounter_Conn), "=") + 1))
                    
                ElseIf Left(Trim(varConnections(intCounter_Conn)), 15) = "Initial Catalog" Then
                    
                    strTemp_Cube = Trim(Mid(varConnections(intCounter_Conn), InStr(varConnections(intCounter_Conn), "=") + 1))
                
                End If
            
            Next intCounter_Conn
            
            strConnectionPair = strTemp_Server & "|" & strTemp_Cube
            
            On Error Resume Next
            mcolServerCubePairs.Add Key:=strConnectionPair, Item:=strConnectionPair
            
        Next pvtTemp
       
    Next intCounter
    
    RefreshCubeServerPairs = True
    
ExitFunction:

    If IsObject(pvtTemp) Then Set pvtTemp = Nothing
    If IsObject(objWorkbook) Then Set objWorkbook = Nothing
    
    Exit Function
    
ErrorTrap:

    GoTo ExitFunction
    
End Function

Public Function ProcessChanges() As Boolean
    
    If mcolSelectedFiles.Count = 0 Then
    
        Err.Raise vbObjectError + 514, "File Modifier", "No files to process."
    
    ElseIf mbolChangeConnection = True And Len(mstrConnection_Verified) = 0 Then
    
        If TestConnectionString = False Then
        
            Err.Raise vbObjectError + 514, "File Modifier", "Missing validated server/cube connection"
        
        End If
    
    ElseIf mbolSaveOnFinish = True And Len(mstrOutputFolderPath) = 0 Then
    
        Err.Raise vbObjectError + 515, "File Modifier", "Missing selected output folder."
        
    Else
        
        Select Case False
        
            Case WorkbboksStillOpen
            
                Err.Raise vbObjectError + 516, "File Modifier", "No workbooks open to process."
                
            Case DoXLAReference
            
                Err.Raise vbObjectError + 517, "File Modifier", "Unable to set XLA reference."
            
            Case DoCode
            
                Err.Raise vbObjectError + 518, "File Modifier", "Unable to write code module."
            
            Case DoCustomProperties
    
                Err.Raise vbObjectError + 519, "File Modifier", "Unable to delete custom properties."
                
            Case DoPageFieldsMulti
            
                Err.Raise vbObjectError + 523, "File Modifier", "Unable to modify page fields."
            
            Case DoRefreshOnOpen
            
                Err.Raise vbObjectError + 520, "File Modifier", "Unable to set RefreshOnOpen."
            
            Case DoChangeConnections
            
                Err.Raise vbObjectError + 521, "File Modifier", "Unable to change OLAP connections."
                
            Case DoSave
            
                Err.Raise vbObjectError + 522, "File Modifier", "Unable to save files."
                
            Case Else
            
                ProcessChanges = True
            
        End Select
            
    End If

End Function

Public Function TestConnectionString() As Boolean

On Error GoTo ErrorTrap

    Dim strConnection As String
    Dim conCube As ADODB.Connection
    
    If Len(mstrConnection_OLAPServer) > 0 And Len(mstrConnection_OLAPCube) > 0 Then
    
        strConnection = Replace(mstrConnection_Test, "ServerName", mstrConnection_OLAPServer)
        strConnection = Replace(strConnection, "CubeName", mstrConnection_OLAPCube)
    
        'test connection
        Set conCube = New ADODB.Connection
        
        With conCube
        
            .ConnectionString = strConnection
            .Open
            
            strConnection = Replace(mstrConnection_Pivots, "ServerName", mstrConnection_OLAPServer)
            strConnection = Replace(strConnection, "CubeName", mstrConnection_OLAPCube)
            
            mstrConnection_Verified = strConnection
                
            TestConnectionString = True
            
            .Close
            
        End With
    
    End If
    
ExitSub:

    If IsObject(conCube) Then Set conCube = Nothing

    Exit Function

ErrorTrap:

    TestConnectionString = False
    
        
    GoTo ExitSub

End Function

Public Sub SetOutputfolder()

On Error GoTo ErrorTrap

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the user-selected folder as a string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim lngResponse As Long
    Dim strPath As String
    Dim fldDialog As Object

    strPath = CurDir

    Set fldDialog = Application.FileDialog(msoFileDialogFolderPicker)
     
    With fldDialog
        .AllowMultiSelect = False
        .Title = "Select an Output Folder for the New Files"
        .InitialFileName = strPath
        .Filters.Clear

        If .Show = True Then
        
            If Right(.SelectedItems.Item(1), 1) = "\" Then

                mstrOutputFolderPath = .SelectedItems.Item(1)

            Else

                mstrOutputFolderPath = .SelectedItems.Item(1) & "\"

            End If
        
        End If

        
    End With

ExitFx:

    If IsObject(fldDialog) Then Set fldDialog = Nothing
    
    Exit Sub
    
ErrorTrap:

    GoTo ExitFx

End Sub

Public Sub SetXLAPAth()

On Error GoTo ErrorTrap

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the user-selected folder as a string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim lngResponse As Long
    Dim strPath As String
    Dim fldDialog As Object

    strPath = CurDir

    Set fldDialog = Application.FileDialog(msoFileDialogFilePicker)
     
    With fldDialog
        .AllowMultiSelect = False
        .Title = "Select an Output Folder for the New Files"
        .InitialFileName = strPath
        .Filters.Clear

        If .Show = True Then
        
            mstrXLAPath = .SelectedItems.Item(1)
            
        End If
        
    End With

ExitFx:

    If IsObject(fldDialog) Then Set fldDialog = Nothing
    
    Exit Sub
    
ErrorTrap:

    GoTo ExitFx

End Sub