Function ImportTAndL(strFile As String)
Dim xlsApp As Excel.Application, xlsWorkbook As Excel.Workbook, xlsSheet As Excel.Worksheet
Dim db As Database,
Dim rs As DAO.Recordset
Dim strProject As String
Dim strBadge As String
[B][COLOR="Red"] Dim strSQL As String[/COLOR][/B]
Dim rng As Range
Dim var() As Variant
If strFile = "" Then
bCanceled = True
Exit Function
Else
bCanceled = False
End If
Set xlsApp = New Excel.Application
Set xlsWorkbook = xlsApp.Workbooks.Open(strFile)
Set xlsSheet = xlsApp.Worksheets(1)
Set db = CurrentDb
Set rsShop = db.OpenRecordset("Select * from [Shops]", dbOpenSnapshot)
Set rsProject = db.OpenRecordset("Select * from [Project Name Ref]", dbOpenSnapshot)
i = xlsSheet.Cells(xlsSheet.Rows.Count, "B").End(xlUp).Row
ReDim var(1 To i, 1 To 17)
Set rng = xlsSheet.Range("B2:Q" & i)
var = rng.Value
For ii = LBound(var) To UBound(var)
'HS(1), BADGE(2), LAST_NM(3), Project(4), Supv(5), Supervisor(6),
'Supv_Project(7) Text46(8), CLASS(9), TITLE(10), START_DT(11),
'END_DT(12), BLDG(13), FLOOR(14), ROOM(15), Instructor(16)
StatusLabel ii & " - " & i
If Len(var(ii, 12)) > 3 Then
If Len(CStr(var(ii, 4))) > 3 Then
strProject = Left(CStr(var(ii, 4)), 3)
Else
strProject = CStr(var(ii, 4))
End If
If Len(CStr(var(ii, 2))) = 5 Then
strBadge = "0" & CStr(var(ii, 2))
Else
strBadge = CStr(var(ii, 2))
End If
[B][COLOR="red"] strSQL = "SELECT * from [Training] WHERE " & _
"[Shop ID] = " & LookupShopMod(CStr(var(ii, 1))) & " AND [Project ID] = " & LookupProjectMod(strProject) & " AND [Badge] = """ & strBadge & """ AND [Start Date] = #" & CDate(var(ii, 11)) & "# AND [End Date] = #" & CDate(var(ii, 12)) & "#"
[/COLOR][/B]
[B][COLOR="red"]Set rs = db.OpenRecordset(strSQL)[/COLOR][/B]
[B][COLOR="red"]If rs.RecordCount = 0 Then
strSQL = "Insert Into [Training] ([Shop ID], [Project ID], [Badge], [Start Date], [End Date]) " & _
"VALUES (" & LookupShopMod(CStr(var(ii, 1))) & "," & LookupProjectMod(strProject) & "," & strBadge & _
"," & CDate(var(ii, 11)) & "," & CDate(var(ii, 12)) & ")"
db.Execute strSQL, dbFailOnError
End If[/COLOR][/B]
Else
If Len(CStr(var(ii, 4))) > 3 Then
strProject = Left(CStr(var(ii, 4)), 3)
Else
strProject = CStr(var(ii, 4))
End If
If Len(CStr(var(ii, 2))) = 5 Then
strBadge = "0" & CStr(var(ii, 2))
Else
strBadge = CStr(var(ii, 2))
End If
[B][COLOR="red"] strSQL = "Select * from [Other Events] " & _
"WHERE [Shop ID] = " & LookupShopMod(CStr(var(ii, 1))) & " AND [Project ID] = " & LookupProjectMod(strProject) & " AND [Badge] = """ & strBadge & """ AND [Start Date] = #" & Format(CDate(var(ii, 11)), "Short Date") & "# AND [Total Time] = " & CLng(var(ii, 12))
Set rs = CurrentDb.OpenRecordset(strSQL)
If rs.RecordCount = 0 Then
strSQL = "Insert Into [Other Events] ([Shop ID],[Project ID],[Badge],[Start Date], [Total Time]) " & _
"VALUES(" & LookupShopMod(CStr(var(ii, 1))) & "," & LookupProjectMod(strProject) & "," & strBadge & _
"," & Format(CDate(var(ii, 11)), "Short Date") & "," & CLng(var(ii, 12)) & ")"
db.Execute strSQL, dbFailOnError[/COLOR][/B]
End If
End If
Next ii
xlsApp.Quit
Set xlsSheet = Nothing
Set xlsWorkbook = Nothing
Set xlsApp = Nothing
rs.Close
Set rs = Nothing
StatusLabel "Completed!"
rsProject.Close
rsShop.Close
Set rsProject = Nothing
Set rsShop = Nothing
End Function