kaoqin.frm

进销存管理系统,我是个新手,请大家多多帮助哈1

         _extentx        =   2355
         _extenty        =   661
         icon            =   "kaoqin.frx":1652
         style           =   8
         caption         =   "   下班考勤"
         iconalign       =   1
         tooltiptitle    =   ""
         tooltipicon     =   0
         tooltiptype     =   0
         font            =   "kaoqin.frx":19EE
      End
      Begin VB.Label Label1 
         Caption         =   "要考勤员工的编号:"
         Height          =   255
         Left            =   240
         TabIndex        =   1
         Top             =   360
         Width           =   1575
      End
   End
End
Attribute VB_Name = "kaoqin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
  'ini文件操作
Private Declare Function GetPrivateProfileString Lib "kernel32" _
   Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String, _
   ByVal lpReturnedString As String, ByVal nSize As Long, _
   ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" _
   Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpString As Any, _
   ByVal lpFileName As String) As Long
   Dim SqlTxt As String
Dim AddFlg As Boolean
Dim conn1 As New ADODB.Connection

Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset





Private Sub Form_Load()
st
tempstart
Text1.Text = Date
Text3.Text = time
End Sub

Private Sub isButton1_Click()

If Combo4.Text = "" Then
MsgBox "尚未选中员工编号", vbInformation
Else
TempSave
End If

End Sub

Private Sub isButton4_Click()
disb
End Sub

Private Sub isButton5_Click()
Unload Me

End Sub





Sub st()
Dim i As Integer
Dim StrConnect As String '定义
   StrConnect = App.Path
    If Right(StrConnect, 1) <> "\" Then StrConnect = StrConnect + "\"
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & StrConnect & "\data\kq.mdb"
rs.Open "select ID,编号 from yggl", conn, 1, 1
i = 0
Do While Not rs.EOF
Combo4.AddItem rs("编号")
Combo4.ItemData(i) = rs("id")
i = i + 1
rs.MoveNext
Loop
list.Text = i
rs.Close
conn.Close
End Sub
Sub disb()
txt_zs.Enabled = False
txt_ws.Enabled = False
txt_zhuangtai.Enabled = False
txt_memo.Enabled = False
End Sub
Sub enbel()
txt_zs.Enabled = True
txt_ws.Enabled = True
txt_zhuangtai.Enabled = True
txt_memo.Enabled = True
End Sub




Sub TempSave()

Dim success As String

success = WritePrivateProfileString(Combo4.Text, "考勤时间", Text1.Text, App.Path & "\temp\temp.ini")
success = WritePrivateProfileString(Combo4.Text, "员工编号", Combo4.Text, App.Path & "\temp\temp.ini")
If Format(time, "h:m") > Format(Text1.Text, "h:m") Then
success = WritePrivateProfileString(Combo4.Text, "状态", "迟到", App.Path & "\temp\temp.ini")
Else
success = WritePrivateProfileString(Combo4.Text, "状态", "白天在岗", App.Path & "\temp\temp.ini")
End If
success = WritePrivateProfileString(Combo4.Text, "上班时间(早)", Text3.Text, App.Path & "\temp\temp.ini")
success = WritePrivateProfileString(Combo4.Text, "备注", "无", App.Path & "\temp\temp.ini")
End Sub
Sub startx()

End Sub
 
 Sub tempstart()
 Dim i As Integer
Dim ret As Long
Dim buff As String
Dim a(60)
Dim B(60)
Dim c(60)
Dim d(60)
Dim e(60)
For i = 1 To list.Text
'读取考勤时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "考勤时间", a(i), buff, 256, App.Path & "\temp\temp.ini")
a(i) = buff
'读取员工编号
buff = String(255, 0)
ret = GetPrivateProfileString(i, "员工编号", B(i), buff, 256, App.Path & "\temp\temp.ini")
B(i) = buff
'读取状态
buff = String(255, 0)
ret = GetPrivateProfileString(i, "状态", c(i), buff, 256, App.Path & "\temp\temp.ini")
c(i) = buff
'读取上班时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "上班时间(早)", d(i), buff, 256, App.Path & "\temp\temp.ini")
d(i) = buff


Next i
Dim objLI As ListItem
Dim si As ListSubItem
   Dim li As ListItem


Dim j As Integer

    Me.ListView1.ColumnHeaders.Add , , "工号"
    Me.ListView1.ColumnHeaders.Add , , "考勤时间"
    Me.ListView1.ColumnHeaders.Add , , "状态"
    Me.ListView1.ColumnHeaders.Add , , "上班时间"
    
    For j = 1 To list.Text
 Set objLI = ListView1.ListItems.Add(Text:=B(j))
 Set si = objLI.ListSubItems.Add(Text:="" & a(j))
  Set si = objLI.ListSubItems.Add(Text:="" & c(j))
   Set si = objLI.ListSubItems.Add(Text:="" & d(j))
 Next j
 
 End Sub

Sub TempSave1()
Dim success As String
If Format(time, "h:m") > Format(Text2.Text, "h:m") Then
success = WritePrivateProfileString(Combo4.Text, "状态", "早退", App.Path & "\temp\temp.ini")
Else
success = WritePrivateProfileString(Combo4.Text, "状态", "晚上在岗", App.Path & "\temp\temp.ini")
End If

success = WritePrivateProfileString(Combo4.Text, "下班时间(晚)", Text3.Text, App.Path & "\temp\temp.ini")
End Sub

Private Sub isButton2_Click()
If Combo4.Text = "" Then
MsgBox "尚未选中员工编号", vbInformation
Else
TempSave1
End If

End Sub

Private Sub isButton3_Click()
data_save
Kill App.Path & "\temp\temp.ini"
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim i As Integer
txt_zhuangtai.Text = ListView1.SelectedItem.SubItems(2)
txt_zs.Text = ListView1.SelectedItem.SubItems(3)
End Sub

Sub data_save()

Dim str As String
Dim j As Integer
Dim i As Integer
Dim ret As Long
Dim buff As String
Dim a(20) As String
Dim B(20) As String
Dim c(20) As Variant
Dim d(20) As Variant
Dim e(20) As Variant

For i = 1 To list.Text
'读取考勤时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "考勤时间", a(i), buff, 256, App.Path & "\temp\temp.ini")
a(i) = LPSTRToVBString(buff)
'读取员工编号
buff = String(255, 0)
ret = GetPrivateProfileString(i, "员工编号", B(i), buff, 256, App.Path & "\temp\temp.ini")
B(i) = LPSTRToVBString(buff)
'读取状态
buff = String(255, 0)
ret = GetPrivateProfileString(i, "状态", c(i), buff, 256, App.Path & "\temp\temp.ini")
c(i) = LPSTRToVBString(buff)
'读取上班时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "上班时间(早)", d(i), buff, 256, App.Path & "\temp\temp.ini")
d(i) = LPSTRToVBString(buff)
'读取下班时间
buff = String(255, 0)
ret = GetPrivateProfileString(i, "下班时间(晚)", e(i), buff, 256, App.Path & "\temp\temp.ini")
e(i) = LPSTRToVBString(buff)
Next i


Dim ssql As String
Dim cnn As New ADODB.Connection
Dim ret1 As New ADODB.Recordset
'连接数据库1
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path & "\data\kq.mdb" + ";Persist Security Info=False;"
ret1.Open "select * from 考勤状态", cnn, 1, 3

   
For j = 1 To list.Text

ret1.MoveLast
ret1.AddNew

ret1.Fields("员工编号") = Trim("" & B(j))
ret1.Fields("状态") = Trim("" & c(j))
ret1.Fields("考勤时间") = Trim("" & Format(a(j), "yyyy-mm-dd"))
ret1.Fields("上班时间") = Trim("" & Format(d(j), "hh:mm:ss"))
ret1.Fields("下班时间") = Trim("" & Format(e(j), "hh:mm:ss"))
ret1.Fields("备注") = "无"
ret1.Update
 

     Next j
     MsgBox "今日的考勤记录已纪录完毕", vbInformation
End Sub

Sub st1()
Dim i As Integer
Dim StrConnect As String '定义
   StrConnect = App.Path
    If Right(StrConnect, 1) <> "\" Then StrConnect = StrConnect + "\"
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & StrConnect & "\data\kq.mdb"
rs.Open "select * from 考勤时间设定", conn, 1, 1
rs.MoveFirst
z.Text = rs.Fields("早上班")
w.Text = rs.Fields("晚下班")
rs.Close
conn.Close
End Sub
'将Null结尾字符串转换到VB字符串
Public Function LPSTRToVBString$(ByVal s$)
    Dim nullpos&
    nullpos& = InStr(s$, Chr$(0))
    If nullpos > 0 Then
       LPSTRToVBString = Left$(s$, nullpos - 1)
    Else
       LPSTRToVBString = ""
    End If
End Function