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

Read Users' Comments (0)

0 Response to "Creating Log Form"