Private Sub cmdGetSource_Click()
Dim excelname As String, AppExcel As New Excel.Application, Wkb As Workbook, Wksh As Worksheet, ce As Object, f As Object, count2 As Integer
Dim obj As AccessObject, dbs As Object, tempTable As String, spaceIn As Integer, response As String
Dim rs As Object, recount As Integer, data As String, count As Integer, daystring As Date, Timed As Date, thisday As String, Code As String
Dim Agent As String, Name As String, rstable As Object, team As Integer, oldagent As String, tic As String
On Error GoTo Errorcatch
oldagent = ""
'DELETE TEMPORARY TABLE
Set dbs = Application.CurrentData
' Search for Temporary Table object in AllTables collection.
tempTable = "no"
For Each obj In dbs.AllTables
If obj.Name = "tbl_Temp" Then
tempTable = "yes"
End If
Next obj
If tempTable = "yes" Then
DoCmd.DeleteObject acTable, "tbl_Temp"
End If
'Open file dialog
Me.selFileName = dbc_OpenFile(Nz(Me.selFileName), , CurrentProject.Path)
If IsNothing(Me.selFileName) Then Exit Sub
'assigned path and file name
excelname = Me.selFileName
Forms("frmImport").cmdGetSource.StatusBarText = "Opening Excel Selected Workbook."
'IMPORT EXCEL WORKSHEET
Set Wkb = AppExcel.Workbooks.Open(excelname)
Set Wksh = Wkb.Sheets(1)
thisday = Wksh.Range("b2")
Wksh.Range("d3").Value = 1
Wksh.Range("d3:d600").Select
With Wkb.Application.Selection
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, date:=xlDay, Step:=1, Trend:=False
End With
Forms("frmImport").cmdGetSource.StatusBarText = "Transferring Worksheet Data."
DoCmd.TransferSpreadsheet acImport, , "tbl_Temp", Me.selFileName, True
Wkb.Save
Wkb.Close
AppExcel.Quit
Set Wkb = Nothing
Set AppExcel = Nothing
Forms("frmImport").cmdGetSource.StatusBarText = "Converting Data."
count = InStr(1, thisday, ":")
thisday = Right(thisday, Len(thisday) - (count + 1))
count = InStr(1, thisday, ",")
daystring = DateValue(Right(thisday, Len(thisday) - (count + 1)))
Me.[Report Date] = daystring
count2 = 0
Set dbs = CurrentDb()
For Each ce In dbs.TableDefs
If ce.Name = "tbl_Temp" Then
For Each f In ce.Fields
count2 = count2 + 1
f.Name = "Field" & count2
If count2 > 6 Then Exit For
Next f
End If
Next ce
Set dbs = Nothing
'CONVERT DATA AND APPEND TO TABLE
Set rs = CurrentDb.OpenRecordset("tbl_Temp Query")
Set rstable = CurrentDb.OpenRecordset("tbl_IdleInformation")
If rstable.RecordCount > 0 Then
rstable.MoveLast
If rstable.date = daystring Then
response = MsgBox("This Report with this date is already on file" & vblinefeed & " Are You Sure You Want to Continue", vbYesNo + vbExclamation + vbDefaultButton2)
If response = vbNo Then
rs.Close
rstable.Close
Set rs = Nothing
Set rstable = Nothing
Exit Sub ' User chose No.
End If
'User Chose Yes
End If
End If
recount = rs.RecordCount
rs.MoveFirst
For count = 1 To recount
If Not IsNull(rs.Fields(0)) Then
data = rs.Fields(0)
If Val(Left(data, 4)) > 8000 Then
Agent = Left(data, 4)
If oldagent = Agent Then
oldagent = ""
Else
oldagent = Agent
Name = Right(data, Len(data) - 7)
End If
End If
If Val(Left(data, 5)) > 100 And Val(Left(data, 5)) < 200 Then team = Val(Mid(data, 3, 3))
If Left(data, 5) = " 001" Or Left(data, 5) = " 002" Then
Code = rs.Fields(0)
Timed = rs.Fields(2)
tic = rs.Fields(1)
With rstable
.AddNew
!date = Me.Report_Date
!team = team
![Idle Code] = Code
![Agent ID] = Val(Agent)
!Agent = Name
!Duration = Timed
![Time In Code] = Val(tic)
.Update
.Bookmark = .LastModified
End With
End If
End If
If rs.EOF Then Exit For
rs.MoveNext
Next count
rs.Close
rstable.Close
Set rs = Nothing
Set rstable = Nothing
MsgBox "Data has been Transferred and Converted"
Forms("frmImport").cmdGetSource.StatusBarText = ""
Exit Sub
errorcatch:
MsgBox Err.Description