Hi all,
I have a macro here that is mostly working. What it is supposed to do is copy the workbook to a network drive, cut open database connections and then refresh all pivots. I've had it so it will do all that when saving to a local drive but when I changed it to save to the network drive it fails to cut the connections. I'm not sure if it refreshes the pivots. Any help would be appreciated.
Here's the code:
Declare Function SetCurrentDirectoryA Lib "KERNEL32" (ByVal lpPathName As String) As Long
Sub AQW_Report()
'
'Refreshes all pivots and cuts connections to Access DB.
'
'Saves the open template to a network drive as a new timestamped workbook.
SetCurrentDirectoryA "\\Ustpa2gtsfp03\L&d\Spq\PRC Team\Reporting\Audit Quality Workshop (AQW) 2011\AQW-PCS\Delivered"
ActiveWorkbook.SaveAs Filename:= _
"\\Ustpa2gtsfp03\L&d\Spq\PRC Team\Reporting\Audit Quality Workshop (AQW) 2011\AQW-PCS\Delivered\AQW PCS 2011 REPORT " & Format(Now, "yyyymmdd hhmm") & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Loops through all the connections in the book and cuts them.
For i = 1 To ActiveWorkbook.Connections.Count
If ActiveWorkbook.Connections.Count = 0 Then Exit Sub
ActiveWorkbook.Connections.Item(i).Delete
i = i - 1
Next i
'Refresh all pivot tables.
ActiveWorkbook.RefreshAll
Sheets("MarketSummary").Select
ActiveSheet.PivotTables("MarketSumm_Pvt").PivotCache.Refresh
Sheets("TeamSummary").Select
ActiveSheet.PivotTables("TeamSumm_Pvt").PivotCache.Refresh
Sheets("Activity Summary").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
End Sub
I have a macro here that is mostly working. What it is supposed to do is copy the workbook to a network drive, cut open database connections and then refresh all pivots. I've had it so it will do all that when saving to a local drive but when I changed it to save to the network drive it fails to cut the connections. I'm not sure if it refreshes the pivots. Any help would be appreciated.
Here's the code:
Declare Function SetCurrentDirectoryA Lib "KERNEL32" (ByVal lpPathName As String) As Long
Sub AQW_Report()
'
'Refreshes all pivots and cuts connections to Access DB.
'
'Saves the open template to a network drive as a new timestamped workbook.
SetCurrentDirectoryA "\\Ustpa2gtsfp03\L&d\Spq\PRC Team\Reporting\Audit Quality Workshop (AQW) 2011\AQW-PCS\Delivered"
ActiveWorkbook.SaveAs Filename:= _
"\\Ustpa2gtsfp03\L&d\Spq\PRC Team\Reporting\Audit Quality Workshop (AQW) 2011\AQW-PCS\Delivered\AQW PCS 2011 REPORT " & Format(Now, "yyyymmdd hhmm") & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Loops through all the connections in the book and cuts them.
For i = 1 To ActiveWorkbook.Connections.Count
If ActiveWorkbook.Connections.Count = 0 Then Exit Sub
ActiveWorkbook.Connections.Item(i).Delete
i = i - 1
Next i
'Refresh all pivot tables.
ActiveWorkbook.RefreshAll
Sheets("MarketSummary").Select
ActiveSheet.PivotTables("MarketSumm_Pvt").PivotCache.Refresh
Sheets("TeamSummary").Select
ActiveSheet.PivotTables("TeamSumm_Pvt").PivotCache.Refresh
Sheets("Activity Summary").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
End Sub