Sub ReceivedCases()
Application.ScreenUpdating = False
ufProgress.LabelProgress.Width = 0
ufProgress.Show
FractionComplete (0)
Dim wkm As Workbook
Dim wkarch As Workbook
Dim wkPiv As Workbook
Dim Fnamem As String
Dim Fnamearch As String
Dim FPath As String
Dim LanID As String
Dim qt As WorkbookQuery
Dim pt As PivotTable
Dim X As Boolean
Dim lRow As Long
Dim lRowl As Long
LanID = Environ("Username")
Shell "C:\Users\" & LanID & "\Desktop\MONTHLY REPORTING\Received Cases\ChangeNames.bat", vbNormalFocus
FPath = "C:\Users\" & LanID & "\Desktop\MONTHLY REPORTING\Received Cases\"
Fnamem = FPath & "Received This Month.xlsx"
Fnamearch = FPath & "Archive Raw Data.xlsx"
Application.ScreenUpdating = False
Set wkm = Workbooks.Open(Fnamem)
wkm.Activate
''wkm.Connections("MONTHLY REPORTING").Refresh BackgroundQuery:=False
''wkm.Connections("Query - Last Month Combined").Refresh BackgroundQuery:=False
''For Each con In wkm.Connections
''Set con = wkm.Connections
''If con.Name = "Query - RAD REPORTING" Then
'' con.Refresh
''Else
'' MsgBox ("Check OUt connection Name")
''End If
FractionComplete (0.25)
Application.ScreenUpdating = False
'';Set qt = wkm.workbookqueries
''qt("MONTHLY REPORTING").Refresh
Dim con As WorkbookConnection
Dim lCnt As Long
'The following code loops through all connections
'in the active workbook. Change the property to
'True to Enable, False to Disable background refresh.
With wkm
For lCnt = 1 To .Connections.Count
'Excludes PowerPivot and other connections
If .Connections(lCnt).Type = xlConnectionTypeOLEDB Then
.Connections(lCnt).OLEDBConnection.BackgroundQuery = False
End If
Next lCnt
End With
''OLEDBConnection.BackgroundQuery = False
For Each con In wkm.Connections
If con.Name = "Query - MONTHLY REPORTING" Then [COLOR=#0000ff]con.Refresh[/COLOR]
Next
For Each con In wkm.Connections
If con.Name = "Query - MONTHLY REPORTING (2)" Then con.Refresh
Next
FractionComplete (0.5)
Application.ScreenUpdating = False
For Each con In wkm.Connections
If con.Name = "Query - Last Month Combined" Then con.Refresh
Next
''wkm.Sheets(1).ListObjects("Last Month Combined").Refresh BackgroundQuery:=False
wkm.Save
Set wkarch = Workbooks.Open(Fnamearch)
wkm.Activate
lRow = Cells(Rows.Count, 1).End(xlUp).Row
wkm.Worksheets(1).Range("A2:AE" & lRow).Copy Destination:=wkarch.Worksheets(2).Range("A" & wkarch.Worksheets(2).Range("A65536").End(xlUp).Row)
''wkarch.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Application.CutCopyMode = False
FractionComplete (0.75)
Application.ScreenUpdating = False
wkm.Save
wkm.Close
wkarch.Save
wkarch.Close
''ThisWorkbook.Activate
''For Each qt In ThisWorkbook.QueryTables
''qt.Refresh BackgroundQuery:=False
''Next qt
''For Each pt In ThisWorkbook.PivotTables
''pt.Refresh
''Next pt
With ThisWorkbook
For lCnt = 1 To .Connections.Count
'Excludes PowerPivot and other connections
If .Connections(lCnt).Type = xlConnectionTypeOLEDB Then
.Connections(lCnt).OLEDBConnection.BackgroundQuery = False
End If
Next lCnt
End With
For Each con In ThisWorkbook.Connections
If con.Name = "Query - Table1" Then con.Refresh
Next
ThisWorkbook.RefreshAll
MsgBox ("Pivots were Updated")
FractionComplete (1)
Unload ufProgress
Application.ScreenUpdating = True
End Sub
Sub FractionComplete(pctdone As Single)
With ufProgress
.LabelCaption.Caption = pctdone * 100 & "% Complete"
.LabelProgress.Width = pctdone * (.FrameProgress.Width)
End With
DoEvents
End Sub