Creating Log Form
Source for Log Form
Dim Cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SintakSQL As String
Dim Item As ListItem
Dim indeks As Integer
Private Sub CmdCari_Click()
Select Case indeks
Case 0
'Cari Seluruh data
Call seluruhdata
Case 1
'Cari Perhari
Call perhari
Case 2
'Cari diantara
Call diantara
End Select
End Sub
Private Sub CmdRefresh_Click()
'Refresh dengan data terbaru
Call subRefresh
End Sub
Private Sub seluruhdata()
'Deklarasikan variabel koneksi
Set Cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
With Cnn
.ConnectionString = "provider=SQLOLEDB;" & _
"Data Source=10.11.12.56,1433/Kenari;initial Catalog = Pulsa;" & _
"User ID=pulsa; Password=Pulsa123"
.Open
End With
rs.CursorLocation = adUseClient
rs.Open "Activity", Cnn
On Error Resume Next
AturListView "Kode Pengguna", 20, "Waktu", 25, "Keterangan", 150
ListView1.ListItems.Clear
i = 1
'tidak diperkenankan ada kosong
'Jika ada field kosong error coba difix kan
Do While Not rs.EOF
'Field Kosong Diabaikan dengan menggunakan perintah
'On error resume next
On Error Resume Next
Set Item = ListView1.ListItems.Add(i, , rs!sandi)
ListView1.ListItems(Rec + 1).Bold = True
ListView1.ListItems(Rec + 1).ForeColor = vbBlue
Item.SubItems(1) = rs!jam
Item.SubItems(2) = rs!activity
rs.MoveNext
Loop
actifitas = Replace(SintakSQL, "'", "`", 1, -1)
SintakSQL = " insert into Activity (sandi, activity) values ('" & namauser & "','" & actifitas & "')"
Cnn.Execute (SintakSQL)
End Sub
Private Sub perhari()
'Deklarasikan variabel koneksi
Set Cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
With Cnn
.ConnectionString = "provider=SQLOLEDB;" & _
"Data Source=10.11.12.56,1433/Kenari;initial Catalog = Pulsa;" & _
"User ID=pulsa; Password=Pulsa123"
.Open
End With
rs.CursorLocation = adUseClient
rs.Open "activity", Cnn
SintakSQL = "Select * From activity where jam like '" & dt_dari.Value & "'"
Set rs = Cnn.Execute(SintakSQL)
On Error Resume Next
AturListView "Kode Pengguna", 20, "Waktu", 25, "Keterangan", 60
ListView1.ListItems.Clear
i = 1
'tidak diperkenankan ada kosong
'Jika ada field kosong error coba difix kan
Do While Not rs.EOF
'Field Kosong Diabaikan dengan menggunakan perintah
'On error resume next
On Error Resume Next
Set Item = ListView1.ListItems.Add(i, , rs!sandi)
ListView1.ListItems(Rec + 1).Bold = True
ListView1.ListItems(Rec + 1).ForeColor = vbBlue
Item.SubItems(1) = rs!jam
Item.SubItems(2) = rs!activity
rs.MoveNext
Loop
actifitas = Replace(SintakSQL, "'", "`", 1, -1)
SintakSQL = " insert into Activity (sandi, activity) values ('" & namauser & "','" & actifitas & "')"
Cnn.Execute (SintakSQL)
End Sub
Private Sub diantara()
'Deklarasikan variabel koneksi
Set Cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
With Cnn
.ConnectionString = "provider=SQLOLEDB;" & _
"Data Source=10.11.12.56,1433/Kenari;initial Catalog = Pulsa;" & _
"User ID=pulsa; Password=Pulsa123"
.Open
End With
rs.CursorLocation = adUseClient
rs.Open "Activity", Cnn
SintakSQL = "Select * From activity where (jam=>'" & dt_dari.Value & "') and (jam<='" & dt_sampai.Value & "')"
Set rs = Cnn.Execute(SintakSQL)
On Error Resume Next
AturListView "Kode Pengguna", 20, "Waktu", 25, "Keterangan", 60
ListView1.ListItems.Clear
i = 1
'tidak diperkenankan ada kosong
'Jika ada field kosong error coba difix kan
Do While Not rs.EOF
'Field Kosong Diabaikan dengan menggunakan perintah
'On error resume next
On Error Resume Next
Set Item = ListView1.ListItems.Add(i, , rs!sandi)
ListView1.ListItems(Rec + 1).Bold = True
ListView1.ListItems(Rec + 1).ForeColor = vbBlue
Item.SubItems(1) = rs!jam
Item.SubItems(2) = rs!activity
rs.MoveNext
Loop
actifitas = Replace(SintakSQL, "'", "`", 1, -1)
SintakSQL = " insert into Activity (sandi, activity) values ('" & namauser & "','" & actifitas & "')"
Cnn.Execute (SintakSQL)
End Sub
Private Sub subRefresh()
'Deklarasikan variabel koneksi
Set Cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
With Cnn
.ConnectionString = "provider=SQLOLEDB;" & _
"Data Source=10.11.12.56,1433/Kenari;initial Catalog = Pulsa;" & _
"User ID=pulsa; Password=Pulsa123"
.Open
End With
rs.CursorLocation = adUseClient
rs.Open "activity", Cnn
On Error Resume Next
AturListView "Kode Pengguna", 20, "Waktu", 25, "Keterangan", 60
ListView1.ListItems.Clear
i = 1
'tidak diperkenankan ada kosong
'Jika ada field kosong error coba difix kan
For i = 1 To 25
Do While Not rs.EOF
'Field Kosong Diabaikan dengan menggunakan perintah
'On error resume next
On Error Resume Next
Set Item = ListView1.ListItems.Add(i, , rs!sandi)
ListView1.ListItems(Rec + 1).Bold = True
ListView1.ListItems(Rec + 1).ForeColor = vbBlue
Item.SubItems(1) = rs!jam
Item.SubItems(2) = rs!activity
rs.MoveNext
Loop
Next i
actifitas = Replace(SintakSQL, "'", "`", 1, -1)
SintakSQL = " insert into Activity (sandi, activity) values ('" & namauser & "','" & actifitas & "')"
Cnn.Execute (SintakSQL)
End Sub
Private Sub Form_Load()
Timer1.Enabled = True
Call subRefresh
Me.Top = (Main.ScaleHeight - Me.ScaleHeight) / 2
Me.Left = (Main.ScaleWidth - Me.ScaleWidth) / 2
End Sub
Public Sub AturListView(ParamArray lstView())
Dim i, Lebar
ListView1.View = lvwReport
Lebar = ListView1.Width - 80
With ListView1.ColumnHeaders
.Clear
For i = 0 To UBound(lstView) - 1 Step 2
.Add , , lstView(i), (lstView(i + 1) _
* Lebar) / 100
Next i
End With
Exit Sub
End Sub
Private Sub CmdSelesai_Click()
Unload Me
Set rs = Nothing
Set Cnn = Nothing
End Sub
Private Sub lihat_Click(Index As Integer)
indeks = Index
Select Case Index
Case 0
dt_dari.Enabled = False: dt_sampai.Enabled = False
dt_dari.Visible = False: dt_sampai.Visible = False
Label1.Visible = False
Case 1
dt_dari.Enabled = True: dt_sampai.Enabled = False
dt_dari.Visible = True: dt_sampai.Visible = False
Label1.Visible = False
Case 2
dt_dari.Enabled = True: dt_sampai.Enabled = True
dt_dari.Visible = True: dt_sampai.Visible = True
Label1.Visible = True
End Select
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Call subRefresh
Timer1.Interval = 10000
Timer1.Enabled = True
End Sub
0 Response to "Creating Log Form"
Posting Komentar