Option Compare Database

'Ver.4 CREATE 2012/12/25

'MAKE AND DEBUG END 2012/12/26

'UPDATE 2013/01/18 'Weekday関数CALL時はvbMondayとしない事で他のMODULEと統一化

Dim SYSTEM_ROOT_PATH As String

Dim FELICA_DAT_PATH As String

Dim FELICA_DAT_FIL_NAM As String

Dim ABS_TIME_FROM(10) As Integer

Dim ABS_TIME_TO(10) As Integer

Dim MM_FOR_LECTURE As Integer

Dim MM_FOR_TESTING As Integer

Dim MM_ATTENDANCE_START As Integer

Dim MM_LATE_CAPA As Integer

Dim MM_FOR_ABSENCE As Integer

Dim FUNC_EARY_BACK As Boolean

Dim FUNC_OPE_ERR As Boolean

Dim EXTERN_MARK As String

Private Function record_write(ByVal s_id As String, _

ByVal gakka As Integer, ByVal gakunenn As Integer, _

ByVal kmk_cd As Integer, ByVal yyyymmddhhmmss As Date) As Boolean

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

Dim yyyy As Integer

Dim tmp As String

Dim wk_yyyymmddhhmmss As Date

record_write = False

wk_yyyymmddhhmmss = yyyymmddhhmmss

yyyy = Year(yyyymmddhhmmss)

If Month(yyyymmddhhmmss) >= 1 And Month(yyyymmddhhmmss) <= 3 Then yyyy = Year(yyyymmddhhmmss) - 1

If FUNC_EARY_BACK = True Then

tmp = """"

tmp = Left$(tmp, 1)

Set db = CurrentDb

strSQL = "SELECT mark, felica_timestamp FROM T_ATTEND_DAT WHERE s_id='" & s_id & "' AND "

strSQL = strSQL & "kmk_cd=" & kmk_cd & " AND "

strSQL = strSQL & "felica_timestamp LIKE " & tmp & Year(yyyymmddhhmmss) & "/"

strSQL = strSQL & Format(Month(yyyymmddhhmmss), "00") & "/" & Format(Day(yyyymmddhhmmss), "00")

strSQL = strSQL & "*" & tmp & " ORDER BY felica_timestamp DESC;"

Set rs = db.OpenRecordset(strSQL)

If rs.RecordCount > 0 Then

If rs.Fields("mark") = "●" Or rs.Fields("mark") = "▲" Then

wk_yyyymmddhhmmss = rs.Fields("felica_timestamp")

EXTERN_MARK = "▼"

End If

rs.Close

Set rs = Nothing

db.Close

Set db = Nothing

End If

Set db = CurrentDb

strSQL = "SELECT mark FROM T_ATTEND_DAT WHERE s_id='" & s_id & "' AND "

strSQL = strSQL & "felica_timestamp=#" & wk_yyyymmddhhmmss & "#;"

Set rs = db.OpenRecordset(strSQL)

If rs.RecordCount < 1 Then

strSQL = "INSERT INTO T_ATTEND_DAT(nenndo, s_id, felica_timestamp, gakka_cd, nense, kmk_cd, mark, upd_timestamp) "

strSQL = strSQL & "VALUES(" & yyyy & ", '" & s_id & "', '" & yyyymmddhhmmss & "', " & gakka

strSQL = strSQL & ", " & gakunenn & ", " & kmk_cd & ", '" & EXTERN_MARK & "', '" & Now() & "');"

db.Execute strSQL

Else

rs.MoveFirst

Do Until rs.EOF

strSQL = "UPDATE T_ATTEND_DAT SET "

strSQL = strSQL & "nenndo=" & yyyy & ", "

strSQL = strSQL & "s_id='" & s_id & "', "

strSQL = strSQL & "felica_timestamp='" & yyyymmddhhmmss & "', "

strSQL = strSQL & "gakka_cd=" & gakka & ", "

strSQL = strSQL & "nense=" & gakunenn & ", "

strSQL = strSQL & "kmk_cd=" & kmk_cd & ", "

strSQL = strSQL & "mark='" & EXTERN_MARK & "', "

strSQL = strSQL & "upd_timestamp='" & Now() & "' "

strSQL = strSQL & "WHERE s_id='" & s_id & "' AND "

strSQL = strSQL & "felica_timestamp=#" & wk_yyyymmddhhmmss & "#;"

db.Execute strSQL

rs.MoveNext

Loop

End If

rs.Close

Set rs = Nothing

db.Close

Set db = Nothing

record_write = True

End Function

Private Function time_tbl_chk(ByVal yyyymmddhhmmss As Date, ByVal yyyy As Integer, _

ByVal gakka As Integer, ByVal gakunenn As Integer, _

ByVal day_of_the_week As Integer, ByVal jigen As Integer) As Integer

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

Dim kbn_for_chk As Integer

time_tbl_chk = -1

Set db = CurrentDb

strSQL = "SELECT kmk_cd, kbn FROM T_TIME_TBL WHERE nenndo=" & yyyy & " AND "

strSQL = strSQL & "gakka_cd=" & gakka & " AND "

strSQL = strSQL & "nense=" & gakunenn & " AND "

strSQL = strSQL & "day_of_the_week=" & day_of_the_week & " AND "

strSQL = strSQL & "jigen=" & jigen & ";"

Set rs = db.OpenRecordset(strSQL)

If rs.RecordCount > 0 Then

If Month(yyyymmddhhmmss) >= 4 And Month(yyyymmddhhmmss) <= 9 Then

kbn_for_chk = 1

Else

kbn_for_chk = 2

End If

If rs.Fields("kbn") = 0 Then

time_tbl_chk = rs.Fields("kmk_cd")

Else

If rs.Fields("kbn") = kbn_for_chk Then time_tbl_chk = rs.Fields("kmk_cd")

End If

rs.Close

Set rs = Nothing

db.Close

Set db = Nothing

End Function

Private Function record_time_chk(ByVal s_id As String, ByVal gakka As Integer, _

ByVal gakunenn As Integer, ByVal yyyymmddhhmmss As Date) As Integer

Dim day_of_the_week, yyyy, kmk_cd, i, abs_hhmm As Integer

record_time_chk = -1

day_of_the_week = Weekday(DateValue(yyyymmddhhmmss))

yyyy = Year(yyyymmddhhmmss)

If Month(yyyymmddhhmmss) >= 1 And Month(yyyymmddhhmmss) <= 3 Then yyyy = Year(yyyymmddhhmmss) - 1

abs_hhmm = Hour(TimeValue(yyyymmddhhmmss)) * 60 + Minute(TimeValue(yyyymmddhhmmss))

jigen = 0

For i = 1 To 5

If abs_hhmm >= (ABS_TIME_FROM(i) - MM_FOR_LECTURE) And abs_hhmm <= ABS_TIME_TO(i) Then

jigen = i

Exit For

End If

Next i

If jigen = 0 Then Exit Function

kmk_cd = time_tbl_chk(yyyymmddhhmmss, yyyy, gakka, gakunenn, day_of_the_week, jigen)

If kmk_cd < 0 Then Exit Function

EXTERN_MARK = "×"

If abs_hhmm >= ABS_TIME_FROM(jigen) - MM_ATTENDANCE_START _

And abs_hhmm <= ABS_TIME_FROM(jigen) + MM_LATE_CAPA Then EXTERN_MARK = "●"

If abs_hhmm > ABS_TIME_FROM(jigen) + MM_LATE_CAPA _

And abs_hhmm <= ABS_TIME_FROM(jigen) + MM_FOR_ABSENCE Then EXTERN_MARK = "▲"

record_time_chk = kmk_cd

End Function

Private Sub get_system_info()

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

Dim i As Integer

Set db = CurrentDb

strSQL = "SELECT card_reader_path, csv_file_name, times_for_normal, times_for_test, "

strSQL = strSQL & "limit_minutes_for_attendance, limit_minutes_for_late, limit_minutes_for_absence, "

strSQL = strSQL & "early_out_function_use, operation_error_function_use, "

For i = 1 To 5

If i <> 5 Then

strSQL = strSQL & "st" & Format(i, "00") & "_hh, " & "st" & Format(i, "00") & "_mm, "

Else

strSQL = strSQL & "st" & Format(i, "00") & "_hh, " & "st" & Format(i, "00") & "_mm "

End If

Next i

strSQL = strSQL & "FROM T_SETUP_INFO;"

Set rs = db.OpenRecordset(strSQL)

FELICA_DAT_PATH = rs.Fields("card_reader_path")

FELICA_DAT_FIL_NAM = rs.Fields("csv_file_name")

MM_FOR_LECTURE = rs.Fields("times_for_normal")

MM_FOR_TESTING = rs.Fields("times_for_test")

MM_ATTENDANCE_START = rs.Fields("limit_minutes_for_attendance")

MM_LATE_CAPA = rs.Fields("limit_minutes_for_late")

MM_FOR_ABSENCE = rs.Fields("limit_minutes_for_absence")

FUNC_EARY_BACK = rs.Fields("early_out_function_use")

FUNC_OPE_ERR = rs.Fields("operation_error_function_use")

For i = 1 To 5

ABS_TIME_FROM(i) = Val(rs.Fields("st" & Format(i, "00") & "_hh")) * 60 + Val(rs.Fields("st" & Format(i, "00") & "_mm"))

ABS_TIME_TO(i) = ABS_TIME_FROM(i) + MM_FOR_LECTURE

Next i

rs.Close

Set rs = Nothing

db.Close

Set db = Nothing

End Sub

Private Function get_gakka_and_gakunenn(ByVal s_id As String) As String

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

get_gakka_and_gakunenn = "NOT FOUND"

Set db = CurrentDb

strSQL = "SELECT gakka, gakunenn FROM T_STUDENT_MST WHERE s_id='" & s_id & "';"

Set rs = db.OpenRecordset(strSQL)

If rs.RecordCount > 0 Then get_gakka_and_gakunenn = rs.Fields("gakka") & "," & rs.Fields("gakunenn")

rs.Close

Set rs = Nothing

db.Close

Set db = Nothing

End Function

Private Function felica_student_id_cnv(ByVal f_id As String) As String

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

felica_student_id_cnv = "NOT FOUND"

Set db = CurrentDb

strSQL = "SELECT s_id FROM T_ID_CONV WHERE felica_id='" & f_id & "';"

Set rs = db.OpenRecordset(strSQL)

If rs.RecordCount > 0 Then felica_student_id_cnv = rs.Fields("s_id")

rs.Close

Set rs = Nothing

db.Close

Set db = Nothing

End Function

Private Sub CommandButton1_Click()

Dim felica_id, s_id, mes, buf As String

Dim fileNo, denominator, proc_cnt, kmk_cd, progress_bar_width_save, ret As Integer

Dim dat_item, tmp As Variant

mes = "障害"

mes_area.Caption = "処理中"

CommandButton2.SetFocus

CommandButton1.Enabled = False

CommandButton3.Enabled = False

progress_bar_width_save = progress_bar.Width

progress_bar.Width = 0

progress_bar_box.Visible = True

progress_bar.Visible = True

get_system_info

proc_cnt = 0

denominator = 0

fileNo = FreeFile

On Error GoTo EXCEPTION_SECTION

Open FELICA_DAT_PATH & "\" & FELICA_DAT_FIL_NAM & ".csv" For Input As #fileNo

On Error GoTo 0

Do Until EOF(fileNo)

Line Input #fileNo, buf

denominator = denominator + 1

Loop

Close #fileNo

If denominator <= 1 Then

ret = MsgBox(FELICA_DAT_PATH & "\" & FELICA_DAT_FIL_NAM & ".csv" & vbCrLf & _

"このファイルにはデータが入っていません。", vbCritical, "CSV FILE VACANT")

GoTo PROC_END

End If

fileNo = FreeFile

Open FELICA_DAT_PATH & "\" & FELICA_DAT_FIL_NAM & ".csv" For Input As #fileNo

Line Input #fileNo, buf 'タイトル行読み飛ばし

mes_area.Caption = "処理を開始しました。しばらくお待ち下さい。"

Do Until EOF(fileNo)

NEXT_READ:

proc_cnt = proc_cnt + 1

Line Input #fileNo, buf

dat_item = Split(buf, ",")

If dat_item(5) = "0" Then GoTo NEXT_READ

felica_id = dat_item(4)

s_id = felica_student_id_cnv(felica_id)

If s_id = "NOT FOUND" Then

ret = MsgBox("FeliCa ID が " & felica_id & " の学生は存在しません。" & vbCrLf & _

"読込処理を続行しますか？", vbYesNo, "FeliCa ID NOT FOUND")

If ret = vbYes Then GoTo NEXT_READ

GoTo PROC_END_2

End If

tmp = get_gakka_and_gakunenn(s_id)

If tmp = "NOT FOUND" Then

ret = MsgBox("学籍番号が " & s_id & " の学生は存在しません。" & vbCrLf & _

"読込処理を続行しますか？", vbYesNo, "FeliCa ID NOT FOUND")

If ret = vbYes Then GoTo NEXT_READ

GoTo PROC_END_2

End If

tmp = Split(tmp, ",")

gakka = tmp(0)

gakunenn = tmp(1)

kmk_cd = record_time_chk(s_id, gakka, gakunenn, dat_item(0) & " " & dat_item(1))

If kmk_cd > 0 Then Call record_write(s_id, gakka, gakunenn, kmk_cd, dat_item(0) & " " & dat_item(1))

mes_area.Caption = proc_cnt & "/ " & (denominator - 1) & "処理完了"

progress_bar.Width = progress_bar_width_save * (proc_cnt / (denominator - 1))

progress_bar.Caption = Round(proc_cnt / (denominator - 1), 2) * 100 & "%"

DoEvents

Loop

mes = "正常"

PROC_END_2:

Close #fileNo

PROC_END:

CommandButton3.Enabled = True

CommandButton2.Enabled = True

CommandButton1.Enabled = True

mes_area.Caption = "処理" & mes & "終了"

Exit Sub

EXCEPTION_SECTION:

ret = MsgBox(FELICA_DAT_PATH & "\" & FELICA_DAT_FIL_NAM & ".csv" & vbCrLf & _

"が見つかりません。環境確認後に再試行して下さい。", vbCritical, "CSV FILE NOT FOUND")

mes = "エラー"

GoTo PROC_END

End Sub

Private Sub CommandButton2_Click()

DoCmd.Close

DoCmd.OpenForm ("F_MAIN_MENU")

End Sub

Private Sub CommandButton3_Click()

sw.Value = "NG"

DoCmd.OpenForm "F_SETUP_ENTER", , , , , acDialog

If sw.Value = "OK" Then DoCmd.OpenForm "F_SETUP_INFO", , , , , acDialog

End Sub

Private Sub Form_Load()

progress_bar_box.Visible = False

progress_bar.Visible = False

End Sub