Permisi Gan... Minta Bantuan nih
ane pnya program absensi pake VB, databasenya pake SQL Windows server 2003 data center edition
mesin absensinya pke biofinger
permasalahany ane pada waktu mau narik data absensi dari mesin absensi ( import data absensi ) mncul error coverting datetime from character string..
ini scriptnya

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{FE9DED34-E159-408E-8490-B720A5E632C7}#1.0#0"; "zkemkeeper.dll"
Begin VB.Form frmAbsensiImport
Caption = "Import Data Absensi"
ClientHeight = 1095
ClientLeft = 60
ClientTop = 450
ClientWidth = 3960
Icon = "frmAbsensiImport.frx":0000
LinkTopic = "Form1"
ScaleHeight = 1095
ScaleWidth = 3960
StartUpPosition = 3 'Windows Default
Begin zkemkeeperCtl.CZKEM CZKEM1
Height = 315
Left = 3225
OleObjectBlob = "frmAbsensiImport.frx":C84A
TabIndex = 2
Top = 450
Width = 390
End
Begin VB.Timer Timer1
Interval = 1000
Left = 480
Top = 0
End
Begin MSWinsockLib.Winsock Winsock1
Left = 0
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
RemoteHost = "192.168.0.20"
RemotePort = 5010
End
Begin VB.Label Label2
Caption = "Please wait !"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1080
TabIndex = 1
Top = 600
Width = 1455
End
Begin VB.Label Label1
Caption = "Still processing ..."
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1080
TabIndex = 0
Top = 240
Width = 2055
End
End
Attribute VB_Name = "frmAbsensiImport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Dim strdata As String, SNabsen As String, TimeAbsen As String
'Dim tombol As Integer, jmlAbsen As Integer, jmlambil As Integer
'Dim kosong As Boolean

Private Sub Form_Load()
'SNabsen = INIGetSettingString("SNabsensi", "SNabsen", FixPath("Absensi.ini"))
'TimeAbsen = INIGetSettingString("TimeAbsensi", "TimeAbsen", FixPath("Absensi.ini"))
'Timer1.Interval = TimeAbsen
'kosong = True
'tombol = 1
'strdata = ""
'ringkas

Dim Tgl As String, strsql As String
'--------------- Import dari mesin
'Dim vMachineNumber
Dim dwVerifyMode As Long
Dim EnrollNumber As String
Dim bConnected As Boolean
Dim dwInOutMode, dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond, dwWorkcode, dwvalue, count As Long
count = 0

Dim ipmesin
ipmesin = INIGetSettingString("IPabsensi", "ipabsen", FixPath("Absensi.ini"))
If bConnected Then
CZKEM1.Disconnect
Else
If CZKEM1.Connect_Net(ipmesin, 4370) Then
CZKEM1.GetDeviceStatus 1, 6, dwvalue
If CZKEM1.ReadGeneralLogData(1) Then
While CZKEM1.SSR_GetGeneralLogData(1, EnrollNumber, dwVerifyMode, dwInOutMode, dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond, dwWorkcode)
'strsql = "Insert into Absensi_Detail_T (EmployeeID,Jam,Line,Tgl) values ( " _
' & "'" & EnrollNumber & "','" & dwHour & ":" & dwMinute & ":" & dwSecond & "', 1 , '" & dwYear & "-" & dwMonth & "-" & dwDay & "')"
'myConn.Execute strsql

Tgl = dwYear & "/" & dwMonth & "/" & dwDay & " " & dwHour & ":" & dwMinute & ":" & dwSecond
strsql = "INSERT INTO PAFinger ( Import, Userid, CheckTime ) " _
& "VALUES ( '" & Format(Now(), "YYYY/MM/DD HH:mm:ss AM/PM") & "' , '" & EnrollNumber & "' , '" & Tgl & "' )"
myConn.Execute strsql
count = count + 1
Wend
End If
If count = dwvalue Then
CZKEM1.ClearGLog 1
Else
Beep
MsgBox "Import data absensi gagal, cobalah beberapa saat lagi !"
Exit Sub
End If
Else
Beep
MsgBox "Koneksi ke Mesin Absensi Terganggu"
Exit Sub
End If
CZKEM1.Disconnect
End If
'--------------- End Import dari mesin
ImportData frmAbsensi.dtpTgl.Value
frmAbsensi.ViewData
Unload Me

End Sub

Private Sub ringkas()
Timer1.Enabled = False
If tombol = 1 Then
Timer1.Interval = 2000
Timer1.Enabled = True
konek
ElseIf tombol = 2 Then
If Winsock1.State <> 7 Then
Unload Me
MsgBox "Gagal terhubung dengan mesin absensi..."
Exit Sub
Else
Timer1.Interval = TimeAbsen
Timer1.Enabled = True
send
End If
ElseIf tombol = 3 Then
Timer1.Enabled = False
receive
If jmlAbsen = 0 And jmlambil = 0 Then
Winsock1.Close
If kosong = True Then
Unload Me
MsgBox "Total data absensi kosong, ulangi beberapa saat lagi"
Exit Sub
End If
ElseIf jmlAbsen <> 0 And jmlambil = 0 Then
Winsock1.Close
Unload Me
MsgBox "import data absensi gagal (kosong), ulangi beberapa saat lagi"
Exit Sub
ElseIf jmlAbsen <> 0 And jmlambil <> 0 And jmlAbsen <> jmlambil Then
Winsock1.Close
Unload Me
MsgBox "import data absensi gagal (terpotong), ulangi beberapa saat lagi"
Exit Sub
ElseIf jmlAbsen <> 0 And jmlambil <> 0 And jmlAbsen = jmlambil Then
'Hapus
Winsock1.Close
End If
ImportData frmAbsensi.dtpTgl.Value
frmAbsensi.ViewData
Unload Me
End If
tombol = tombol + 1
End Sub

Private Sub Timer1_Timer()
ringkas
End Sub

Private Sub konek()
Dim ipabsen As String
ipabsen = INIGetSettingString("IPabsensi", "ipabsen", FixPath("Absensi.ini"))
Winsock1.Close
Winsock1.RemoteHost = ipabsen
Winsock1.Connect
End Sub

Private Sub send()
Winsock1.SendData ("(" & SNAbsen & ",kqdata)")
End Sub

Private Sub Hapus()
Winsock1.SendData ("(" & SNAbsen & ",kqdelall)")
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim paket As String
Winsock1.GetData paket
strdata = strdata + paket
End Sub

Private Sub receive()
Dim temp As String, karakter As String, ID As String, Tgl As String, strsql As String, strsqlS As String
Dim count As Long, i As Integer
Dim PgwRS As ADODB.Recordset
Dim titip As String

strsql = "DELETE FROM PACheckinoutTemp"
myConn.Execute strsql

temp = strdata
count = Len(strdata)
If temp <> "" Then
kosong = False
End If
jmlambil = 0
jmlAbsen = 0
If count > 0 Then
For i = 1 To count + 1
If Mid(temp, i, 1) = ")" Then
If InStr(karakter, "cmd") < 1 Then

ID = Mid(karakter, 12, 3)
Tgl = Mid(karakter, 18, 2) + "/" + Mid(karakter, 20, 2) + "/" + Mid(karakter, 16, 2)
Tgl = Tgl + " " + Mid(karakter, 23, 2) + ":" + Mid(karakter, 25, 2) + ":" + Mid(karakter, 27, 2)

'strsql = "INSERT INTO CheckinoutTemp ( Userid, CheckTime, CheckType, Sensorid, Checked ) " _
& "VALUES ( '" & ID & "' , #" & Tgl & "# , 'I' , '" & SNabsen & "' , '0' )"
'AccessConn.Execute strsql

strsqlS = "INSERT INTO PACheckinoutTemp ( Import, Userid, CheckTime, CheckType, Sensorid, Checked ) " _
& "VALUES ( '" & Format(Now(), "YYYY/MM/dd HH:mm:ss AM/PM") & "' , '" & ID & "' , '" & Tgl & "' , 'I' , '" & SNAbsen & "' , '0' )"
myConn.Execute strsqlS
strsqlS = "INSERT INTO PACheckinout ( Import, Userid, CheckTime, CheckType, Sensorid, Checked ) " _
& "VALUES ( '" & Format(Now(), "YYYY/MM/dd HH:mm:ss AM/PM") & "' , '" & ID & "' , '" & Tgl & "' , 'I' , '" & SNAbsen & "' , '0' )"
myConn.Execute strsqlS

jmlambil = jmlambil + 1
Else
If jmlAbsen = 0 Then
jmlAbsen = Val(Mid(karakter, 16, 6))
End If
End If
karakter = ""
Else
karakter = karakter + Mid(temp, i, 1)
End If
Next
Else
End If

End Sub

Private Sub ImportData(Tgl As Date)
Dim strsql As String, strsqltemp As String
Dim AccRS As ADODB.Recordset, AccRStemp As ADODB.Recordset
Dim token As Boolean
Dim conter As Integer

strsql = "SELECT NIK FROM PAABSENSI WHERE TGL='" & Format(Tgl, "yyyy-mm-dd") & "'"
token = IsRecordEmpty(strsql)
If Not token Then
If MsgBox("Data Absensi tanggal '" & Format(Tgl, "dd-mmm-yyyy") & "' sudah ada." & vbCr _
& "Apakah Anda ingin menghapus dan menggantinya dengan data yang baru ?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
End If

On Error GoTo Hell:
myConn.Execute "DELETE FROM PAABSENTEMP"

'---------------------
strsqltemp = "INSERT INTO PACheckinoutReal SELECT DISTINCT t.Userid, t.CheckTime, t.CheckType, t.Sensorid, t.Checked " _
& "FROM PACheckinoutTemp t LEFT OUTER JOIN PACheckinoutReal c " _
& "ON t.Userid = c.Userid AND t.CheckTime = c.CheckTime WHERE c.Userid Is Null"
myConn.Execute strsqltemp

Set AccRStemp = New ADODB.Recordset
If AccRStemp.State = 1 Then AccRStemp.Close
strsqltemp = "SELECT distinct (USERID) FROM PACheckinoutReal " _
& "WHERE YEAR(CHECKTIME)='" & Format(Tgl, "yyyy") & "' " _
& "AND MONTH(CHECKTIME)='" & Format(Tgl, "mm") & "' " _
& "AND DAY(CHECKTIME)='" & Format(Tgl, "dd") & "' "
AccRStemp.Open strsqltemp, myConn, adOpenStatic, adLockReadOnly
While Not AccRStemp.EOF

Set AccRS = New ADODB.Recordset
If AccRS.State = 1 Then AccRS.Close
strsql = "SELECT USERID,CHECKTIME FROM PACheckinoutReal " _
& "WHERE USERID = '" & AccRStemp.Fields(0) & "' " _
& "AND YEAR(CHECKTIME)='" & Format(Tgl, "yyyy") & "' " _
& "AND MONTH(CHECKTIME)='" & Format(Tgl, "mm") & "' " _
& "AND DAY(CHECKTIME)='" & Format(Tgl, "dd") & "' " _
& "ORDER BY CHECKTIME"
AccRS.Open strsql, myConn, adOpenStatic, adLockReadOnly
conter = 1
While Not AccRS.EOF
strsql = "INSERT INTO PAABSENTEMP VALUES(" _
& AccRS.Fields(0) & ",'" & Format(AccRS.Fields(1), "hh:mm:ss") & "'," _
& conter & ",'" & Format(AccRS.Fields(1), "yyyy-mm-dd") & "')"
myConn.Execute strsql
conter = conter + 1
AccRS.MoveNext
Wend

AccRStemp.MoveNext
Wend

'---------------------

'Set AccRS = New ADODB.Recordset
'strsql = "SELECT EMPLOYEEID,TIMEVALUE(JAM),LINE,DATEVALUE(TGL) FROM ABSENSI_DETAIL_T " _
' & "WHERE DATEVALUE(TGL)=#" & Format(Tgl, "yyyy-mm-dd") & "#"
'AccRS.Open strsql, AccessConn, adOpenStatic, adLockReadOnly
'While Not AccRS.EOF
' strsql = "INSERT INTO PAABSENTEMP VALUES(" _
' & AccRS.Fields(0) & ",'" & Format(AccRS.Fields(1), "hh:mm:ss") & "'," _
' & AccRS.Fields(2) & ",'" & Format(AccRS.Fields(3), "yyyy-mm-dd") & "')"
' myConn.Execute strsql
' AccRS.MoveNext
'Wend

myConn.Execute "EXEC spImportAbsensi '" & Format(Tgl, "yyyy-mm-dd") & "'"
MsgBox "Import data Absensi pertanggal '" & Format(Tgl, "dd-mm-yyyy") & "' sukses !", vbInformation

EarlyExit:
AccRStemp.Close
Set AccRStemp = Nothing
Exit Sub

Hell:
ErrMsg
GoTo EarlyExit
End Sub


ScreenShoot