Hello Mr. Excel Nation!
I am having challenges in updating Excel files stored in a SharePoint site. The code executes and works fine, except when it comes time to review the files, they have been refreshed but not closed properly?! I am refreshing several files at a time and it seems like maybe a refreshing activity is not quite completed before the closing occurs? I am not certain but I can't seem to find where the issue is. I am hopeful that someone may know where I can add some code to have the process execute more smooth.
I am having challenges in updating Excel files stored in a SharePoint site. The code executes and works fine, except when it comes time to review the files, they have been refreshed but not closed properly?! I am refreshing several files at a time and it seems like maybe a refreshing activity is not quite completed before the closing occurs? I am not certain but I can't seem to find where the issue is. I am hopeful that someone may know where I can add some code to have the process execute more smooth.
VBA Code:
Do While x <= ReportCount 'Loop established for the entire report list
Do While Cells(x, 14).Value <> ""
Set rng = Cells(x, 14)
rng.Offset(, 2).Value = Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM")
wbFile = Cells(x, 25).Value
y = y + 1
Select Case Cells(x, 14).Value
Case "REFRESH"
Workbooks.CheckOut wbFile
Set wb = Workbooks.Open(wbFile)
successCount = 0
failureCount = 0
ErrorTag = ""
On Error Resume Next
For Each cn In wb.Connections
lTest = InStr(1, cn.OLEDBConnection.Connection, "Provider=Microsoft", vbTextCompare)
If Err.Number <> 0 Then
Err.Clear
Exit For
End If
If lTest > 0 Then
StartT = Timer
connEnabled = cn.OLEDBConnection.EnableRefresh
cn.OLEDBConnection.EnableRefresh = True
If Err.Number <> 0 Then 'Error when enabling refresh for connection only queries
Err.Clear
GoTo skipConnectionOnlyRefresh
End If
backgroundQueryEnabled = cn.OLEDBConnection.BackgroundQuery
cn.OLEDBConnection.BackgroundQuery = False
cn.Refresh
If Err.Number <> 0 Then
Err.Clear
ErrorTag = ErrorTag & cn.Name & " failed to refresh;"
With ErrorLog
.WriteLog Report_Name:=Cells(x, 2).Value, _
Total_Duration:=Format(Now - rng.Offset(, 2).Value, "h:mm:ss"), _
Query_Duration:=Format(DurationT / 86400, "h:mm:ss"), _
Query_Name:=cn.Name, _
eStatus:=" *** Failed to Refresh *** ", _
eComment:="Review the report for error(s)"
End With
failureCount = failureCount + 1
wb.CheckIn False
Exit For
Else
successCount = successCount + 1
Debug.Print " - " & Format(DurationT / 86400, "h:mm:ss") & " - " & Replace(cn.Name, "Query - ", "") & " SUCCESS"
With ErrorLog
.WriteLog Report_Name:=rng.Offset(, -12).Value, _
Total_Duration:=Format(Now - rng.Offset(, 2).Value, "h:mm:ss"), _
Query_Duration:=Format(DurationT / 86400, "h:mm:ss"), _
Query_Name:=cn.Name, _
eStatus:=" SUCCESS ", _
eComment:="Successful Refresh of query"
End With
End If
wb.Application.CalculateUntilAsyncQueriesDone
DoEvents
cn.OLEDBConnection.BackgroundQuery = backgroundQueryEnabled
If connEnabled = False Then
cn.OLEDBConnection.EnableRefresh = False
End If
DurationT = Timer - StartT
TotalT = TotalT + DurationT
End If
skipConnectionOnlyRefresh:
Next cn
Debug.Print "Refreshed " & successCount & " connection(s) for workbook: """ & wb.Name & """" & ". Failed to refresh " & failureCount & " connection(s)."
With ErrorLog
.WriteLog Report_Name:=Cells(x, 2).Value, _
Total_Duration:="", _
Query_Duration:="", _
Query_Name:="", _
eStatus:="Synopsis", _
eComment:="Refreshed " & successCount & " connection(s) for workbook: """ & wb.Name & """" & ". Failed to refresh " & failureCount & " connection(s)."
End With
With wb
For Each pc In wb.PivotCaches
On Error Resume Next
pc.Refresh
Next pc
End With
wb.Application.DisplayAlerts = False
DoEvents
wb.CheckIn True, "Automated Refresh"
wb.Close 'is this the solution?
Application.DisplayAlerts = True
If ErrorTag <> "" Then
Report_Failed_Update Cells(x, 14), "Failure: " & ErrorTag
ReportError = ReportError + 1
Else
Report_Successful_Update Cells(x, 14)
ReportSuccess = ReportSuccess + 1
End If
Case "ARCHIVE", "REACTIVATE"
UpdateMeta Cells(x, 25).Value, Cells(x, 14).Value
Report_Successful_Update Cells(x, 14)
ReportSuccess = ReportSuccess + 1
End Select
x = x + 1
Loop
Set wb = Nothing
x = x + 1
Loop
