Public Sub GetNewData()
DoCmd.SetWarnings (False)
Dim fs As FileSystemObject
Dim f As Object
Dim FileArray() As String
Dim FileToDoArray() As String
Dim FileTimeArray() As Double
Dim DatabaseTimeArray() As Double
Dim qryTemp As String
Dim rs As Object
Dim entryCount As Integer
Dim Size As Double
Dim Size2 As Double
Dim dStart As Double
Dim dEnd As Double
dStart = Now
Pause (1)
DoCmd.SetWarnings (False)
qryTemp = "SELECT DISTINCT a.FileName, a.DateTime" & _
" FROM ImportLog a WHERE a.DateTime = (SELECT MAX(b.DateTime) FROM ImportLog b WHERE b.FileName = a.FileName GROUP BY FileName) ORDER BY DateTime DESC"
Set rs = CurrentDb.OpenRecordset(qryTemp)
Set fs = New FileSystemObject
entryCount = rs.RecordCount
ReDim FileArray(entryCount - 1)
ReDim DatabaseTimeArray(entryCount - 1)
ReDim FileTimeArray(entryCount - 1)
i = 0
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
FileArray(i) = rs.Fields("FileName").Value
DatabaseTimeArray(i) = rs.Fields("DateTime").Value
Set f = fs.GetFile("\\st1w3105\results\" & rs.Fields("FileName").Value & ".txt")
FileTimeArray(i) = f.DateLastModified
If f.DateLastModified > DatabaseTimeArray(i) Then
ReDim Preserve FileToDoArray(i)
FileToDoArray(i) = FileArray(i)
End If
i = i + 1
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
If IsEmpty(FileToDoArray()) Then
GoTo endprocess
End If
On Error GoTo endprocess
For Each i In FileToDoArray()
If i = "" Then
Else
Set f = fs.GetFile("\\st1w3105\results\" & i & ".txt")
Size = f.Size / 1024
If Size < 1 Then
Do While Size < 1
Size = f.Size / 1024
If Now > dStart + #12:05:00 AM# Then
GoTo getoutofloop
End If
Loop
End If
Pause (1)
Size2 = f.Size / 1024
Do While Not Size2 = Size
Size = f.Size / 1024
Pause (1)
Size2 = f.Size / 1024
If Now > dStart + #12:06:00 AM# Then
GoTo getoutofloop
End If
Loop
End If
Next
For Each i In FileToDoArray()
If i = "" Then
Else
DoCmd.RunSavedImportExport ("Import-" & i)
End If
Next
getoutofloop:
Delete_tbl
DoCmd.RunSQL "DELETE * FROM WFM_Plan_Forecast WHERE Date_ IS NULL"
DoCmd.RunSQL "UPDATE WFM_Plan_Forecast SET THT = fcstContactsReceived * fcstAHT, [Datetime] = CDate(CStr([Date_]) & ' ' & Period & ':00')"
DoCmd.RunSQL "UPDATE WFM_Plan_Forecast AS t INNER JOIN tbl_Entity_Sets AS ent ON t.ctID = ent.ctID SET t.Entity_Set_ID = ent.Entity_Set_ID, t.Entity_Set = ent.Entity_Set"
DoCmd.RunSQL "DELETE * FROM tbl_CT_All_Forecast"
DoCmd.RunSQL "INSERT INTO tbl_CT_All_Forecast SELECT Datetime, Date_ AS [Date], Period AS Period, ctID AS ctID, ctName AS ctName, acdID AS acdID, fcstContactsReceived AS fcstContactsReceived, fcstContactsHandled AS fcstContactHandled, fcstAHT AS fcstAHT, fcstSLPct AS fcstSLPct, fcstOcc AS fcstOcc, fcstASa AS fsctASa, fcstReq AS fcstReq, revPlanReq AS revPlanReq, commitPlanReq AS commitPlanReq, schedOpen AS schedOpen, THT, Entity_Set_ID, Entity_Set FROM WFM_Plan_Forecast WHERE fcstContactsReceived > 0"
qryTemp = "SELECT DISTINCT fcst.ctID, fn.FileName FROM WFM_Plan_Forecast fcst INNER JOIN tbl_Entity_Sets fn ON fcst.ctID = fn.ctID"
Set rs = CurrentDb.OpenRecordset(qryTemp)
entryCount = rs.RecordCount
Do Until rs.EOF = True
a = Format(rs.Fields("FileName").Value, "@")
DoCmd.RunSQL "INSERT INTO ImportLog VALUES (Now, GetUserName(), " & rs.Fields("ctID").Value & ", " & Chr(34) & a & Chr(34) & ")"
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
DoCmd.RunSQL "DELETE * FROM WFM_Plan_Forecast"
qryTemp = "SELECT DISTINCT fcst.ctID, fn.FileName FROM WFM_Plan_Forecast fcst INNER JOIN tbl_Entity_Sets fn ON fcst.ctID = fn.ctID"
DoCmd.SetWarnings (True)
dEnd = Now
endprocess:
For Each i In Array("tbl_MCT_CALL", "tbl_CT_CALL_1", "tbl_CT_CALL_2", "tbl_CT_CALL_3")
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim w As Variant
On Error GoTo skipupdate
Set xlApp = GetObject(, "Excel.Application")
qryTemp = "SELECT TOP 1 WorkbookName FROM WorkbookLog ORDER BY Time Desc"
Set rs = CurrentDb.OpenRecordset(qryTemp)
entryCount = rs.RecordCount
Do Until rs.EOF = True
a = Format(rs.Fields("WorkbookName").Value, "@")
wbname = a
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
On Error GoTo errorcatch
Set wb = xlApp.Workbooks(wbname)
wb.Sheets(i).Activate
Set ws = wb.Sheets(i)
If i = "tbl_MCT_CALL" Then
ctSetCurr = ws.Range("B1")
ctCurr = 0
fromdate = Format(ws.Range("B2"), "dd/mm/yyyy")
todate = Format(ws.Range("B3"), "dd/mm/yyyy")
Else
ctSetCurr = ws.Range("C1")
ctCurr = ws.Range("B1")
fromdate = Format(ws.Range("B2"), "dd/mm/yyyy")
todate = Format(ws.Range("B3"), "dd/mm/yyyy")
End If
If ctCurr = 0 Then
qryTemp = "SELECT ct.[Datetime], MAX(ct.[Date]), MAX(ct.Period), MAX(ct.Entity_Set_ID), MAX(ct.Entity_Set)," & _
" SUM(ct.fcstContactsReceived), SUM(ct.THT)/SUM(ct.fcstContactsReceived) AS AHT, SUM(ct.SchedOpen) FROM tbl_CT_All_Forecast AS ct" & _
" WHERE (ct.Entity_Set_ID = " & ctSetCurr & ") AND ct.Date >= #" & Format(DateValue(fromdate), "yyyy\/mm\/dd") & "# And ct.Date <= #" & Format(DateValue(todate), "yyyy\/mm\/dd") & "#" & _
"GROUP BY ct.[Datetime]"
Else
qryTemp = "SELECT tbl_CT_All_Forecast.[Datetime], tbl_CT_All_Forecast.[Date], tbl_CT_All_Forecast.Period, tbl_CT_All_Forecast.Entity_Set, tbl_CT_All_Forecast.Entity_Set_ID, tbl_CT_All_Forecast.ctID, tbl_CT_All_Forecast.fcstContactsReceived, tbl_CT_All_Forecast.fcstAHT, tbl_CT_All_Forecast.schedOpen" & _
" FROM tbl_CT_All_Forecast" & _
" WHERE tbl_CT_All_Forecast.Date >= #" & Format(DateValue(fromdate), "yyyy\/mm\/dd") & "# And tbl_CT_All_Forecast.Date <= #" & Format(DateValue(todate), "yyyy\/mm\/dd") & "# AND (tbl_CT_All_Forecast.ctID= " & ctCurr & ")"
End If
Set rs = CurrentDb.OpenRecordset(qryTemp, , 4)
Dim lRS As Long
lRS = rs.RecordCount
ws.Range("B6").CopyFromRecordset rs, lRS, 15
Set rs = Nothing
Next
skipupdate:
On Error GoTo errorcatch
Erase FileToDoArray()
Exit Sub
errorcatch:
CurrentDb.Close
End Sub
Public Function GetUserName() As String
GetUserName = UCase(CreateObject("WScript.Network").UserName)
End Function
Sub Delete_tbl()
Dim t As Object
For Each t In CurrentDb.TableDefs
If t.Name Like "*ImportErrors*" Then DoCmd.RunSQL ("DROP TABLE " & t.Name)
Next
End Sub
Public Function Pause(NumberOfSeconds As Variant)
On Error GoTo Error_GoTo
Dim PauseTime As Variant
Dim Start As Variant
Dim Elapsed As Variant
PauseTime = NumberOfSeconds
Start = Timer
Elapsed = 0
Do While Timer < Start + PauseTime
Elapsed = Elapsed + 1
If Timer = 0 Then
PauseTime = PauseTime - Elapsed
Start = 0
Elapsed = 0
End If
DoEvents
Loop
Exit_GoTo:
On Error GoTo 0
Exit Function
Error_GoTo:
Debug.Print Err.Number, Err.Description, Erl
GoTo Exit_GoTo
End Function
