<ASK>Source VB6 error <Cendol menuggu>

[Braincode]

Agan yang master VB6 mau tanya source code ane gan......

ini codenya


Code:

Option Explicit

Dim rstTrans As ADODB.Recordset

Public Sub LoadData()
Set rstTrans = New ADODB.Recordset
gstrSQL = "Select * From pelajaran"
gstrSQL = "Select A.idgm, A.idguru, B.nama As namaguru, A.idkelas AS idkelas, C.namakelas AS namakelas, A.idmatpel, D.matapelajaran " & vbCrLf _
& "From gurumatpel A " & vbCrLf _
& "Left Outer Join guru B On B.idguru = A.idguru " & vbCrLf _
& "Left Outer Join kelas C On C.idkelas = A.idkelas " & vbCrLf _
& "Left Outer Join matpel D On D.idmatpel = A.idmatpel " & vbCrLf _
& "Order By A.idgm, A.idguru, A.idkelas, A.idmatpel "
Set rstTrans = Cn.Execute(gstrSQL)

Set dgrData.DataSource = rstTrans
End Sub

Private Sub btnAdd_Click()
frmCreate.pTransJns = "ADD"
frmCreate.Show
End Sub

Private Sub btnEdit_Click()
If rstTrans.State = adStateClosed Then
MsgBox "Data kosong"
Exit Sub
End If
If (rstTrans.BOF And rstTrans.EOF) Then
MsgBox "Data kosong"
Exit Sub
End If

frmCreate.pTransJns = "EDIT"
frmCreate.pTransID = rstTrans![idgm]
frmCreate.Show
End Sub

Private Sub btnExit_Click()
End
End Sub

Private Sub Form_Load()
If IsConnectDB("localhost", "root", "", "akademik") = False Then
MsgBox "Tidak terkoneksi"
End
Exit Sub
End If

Call LoadData
End Sub

Penampakannya gini gan





yang ke dua ini gan kodenya


Code:

Option Explicit

Public pTransJns As String
Public pTransID As String

Dim rstGuru As ADODB.Recordset
Dim rstKelas As ADODB.Recordset
Dim rstMatPel As ADODB.Recordset
Dim rstTrans As ADODB.Recordset

Private Sub loadGuru()
Set rstGuru = New ADODB.Recordset
If rstGuru.State = adStateOpen Then rstGuru.Close
gstrSQL = "Select idguru, nip, nama, alamat From guru"
Set rstGuru = Cn.Execute(gstrSQL)
Set dcbGuru.RowSource = rstGuru

dcbGuru.ListField = "nama"
dcbGuru.DataField = "idguru"
dcbGuru.BoundColumn = "idguru"

dcbGuru.BoundText = vbNullString
End Sub
Private Sub loadKelas()
Set rstKelas = New ADODB.Recordset
If rstKelas.State = adStateOpen Then rstKelas.Close
gstrSQL = "Select idkelas, nama, jurusan From kelas"
Set rstKelas = Cn.Execute(gstrSQL)
Set dcbKelas.RowSource = rstKelas
dcbKelas.ListField = "nama"
dcbKelas.DataField = "idkelas"
dcbKelas.BoundColumn = "idkelas"

dcbKelas.BoundText = vbNullString
End Sub

Private Sub loadTrans()
Set rstTrans = New ADODB.Recordset
If rstTrans.State = adStateOpen Then rstTrans.Close
gstrSQL = "Select A.idgm, A.idguru, A.kelas, A.idmatpel " & vbCrLf _
& "From gurumatpel A " & vbCrLf _
& "Left Outer Join Kelas B On B.namakelas = A.kelas " & vbCrLf _
& "Where idgm = '" & pTransID & "'"
Set rstTrans = Cn.Execute(gstrSQL)
If Not (rstTrans.BOF And rstTrans.EOF) Then
txtID.Text = rstTrans![idgm]
If IsNull(rstTrans![idguru]) Then
dcbGuru.BoundText = vbNullString
Else
dcbGuru.BoundText = rstTrans![idguru]
End If
If IsNull(rstTrans![kelas]) Then
cboKelas.ListIndex = -1
Else
cboKelas.Text = rstTrans![kelas]
End If
If IsNull(rstTrans![idmatpel]) Then
dcbMatPel.BoundText = vbNullString
Else
dcbMatPel.BoundText = rstTrans![idmatpel]
End If
Else
txtID.Text = vbNullString
dcbGuru.BoundText = vbNullString
cboKelas.ListIndex = -1
dcbMatPel.BoundText = vbNullString
End If

If UCase$(pTransJns) = "ADD" Then
txtID.Locked = False
Else
txtID.Locked = True
End If
End Sub

Private Sub clearComponent()
dcbGuru.BoundText = vbNullString
cboKelas.ListIndex = -1
dcbMatPel.BoundText = vbNullString

pTransID = vbNullString
End Sub

Private Sub btnClose_Click()
Unload Me
End Sub

'---------------------------------------------------------------------------------------
' Procedure : btnSave_Click
' Author : admin
' Date : 5/7/2010
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub btnSave_Click()
On Error GoTo btnSave_Click_Error

If txtID.Text = vbNullString Then
MsgBox "Isi ID"
txtID.SetFocus
Exit Sub
End If
If dcbGuru.BoundText = vbNullString Then
MsgBox "Pilih Guru"
dcbGuru.SetFocus
Exit Sub
End If
If cboKelas.Text = vbNullString Then
MsgBox "Pilih Kelas"
cboKelas.SetFocus
Exit Sub
End If
If dcbMatPel.BoundText = vbNullString Then
MsgBox "Pilih MatPel"
dcbMatPel.SetFocus
Exit Sub
End If

If UCase$(pTransJns) = "ADD" Then
gstrSQL = "Insert Into gurumatpel (idguru, kelas, idmatPel) Values ('" & dcbGuru.BoundText & "', '" & cboKelas.Text & "', '" & dcbMatPel.BoundText & "')"
Cn.Execute (gstrSQL)
ElseIf UCase$(pTransJns) = "EDIT" Then
gstrSQL = "Update gurumatpel Set idguru = '" & dcbGuru.BoundText & "', kelas = '" & cboKelas.Text & "', idmatpel = '" & dcbMatPel.BoundText & "' Where idgm = '" & pTransID & "'"
Cn.Execute (gstrSQL)
End If

txtID.Locked = True
pTransJns = "EDIT"
frmView.LoadData

MsgBox "Sukses..."

On Error GoTo 0
Exit Sub

btnSave_Click_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure btnSave_Click of Form frmCreate"
End Sub

Private Sub Form_Load()
If UCase$(pTransJns) = "ADD" Then
Call loadGuru
Call loadKelas
'Call loadMatPel

Call clearComponent
ElseIf UCase$(pTransJns) = "EDIT" Then
Call loadGuru
Call loadKelas
'Call loadMatPel

Call loadTrans
End If
End Sub

Penampakannya ini gan





ini kode mudulnya




Code:

Option Explicit
Public gstrSQL As String
Public Cn As New ADODB.Connection

Public Function IsConnectDB(ByVal psServer As String, ByVal psUser As String, ByVal psPass As String, ByVal psDB As String) As Boolean
On Error GoTo isConnectDB_Error

IsConnectDB = False

Dim strConn As String

Set Cn = New ADODB.Connection
Cn.CursorLocation = adUseClient
'strConn = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & psServer & "; UID=" & psUser & "; PWD=" & psPass & "; DATABASE=" & psDB & "; PORT=3306; OPTION=3 "
strConn = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & psServer & ";DATABASE=" & psDB & ";UID=" & psUser & ";PWD=" & psPass & ";PORT=3306;OPTION=3"
With Cn
.ConnectionString = strConn
.Open
End With

IsConnectDB = True

On Error GoTo 0
Exit Function

isConnectDB_Error:

MsgBox "Gak connect..."
End Function





errornya kayak gini gan





error yang ada merah-merahnya,,,



ini databasenya namanya akademik, tabel yang dipakek guru,kelas,matpel





tolong ya gan,,,nanti pasti dikasih