membuat kode otomatis pada vb 6

aduh udah lama tidak posting tutorial jadi bingung lagi deh, sampe2 Rank Alexa nya juga jadi NO DATA :( hufh..
pada postingan ini saya akan mencoba membuat kode otomatis menggunakan VB 6. kode otomatis itu sendidi biasanya digunakan untuk ID atau kode yang bersifat unik, dan disini saya akan mencoba membuat kode otomatis dengan cara mengecek terlebih dahulu pada database. saya akan mencontohkan dalam sebuah form dengan validasi dan penanganan error atau mencegah terjadinya kesalahan pada saat penginputan data oleh pengguna/user. ok kita langsung aja membuat databasenya terlebih dahulu, oia disini saya menggunakan Microsoft Office Access sebagai databasenya biar aga simple dikit .hhehe
databasenya simpan dengan nama kode_otomatis.mdb

id_konsumen (Text) 5
nm_konsumen (Text) 15 
alamat (Text) 25
telp (Text) 13

selanjutnya kita buat project baru, dan membuat 1 buah form dengan nama Form1, dan tambahkan komponen berikut:

image

berikut adalah kodenya:

' mendeklarasikan ID_KONSUMEN
Dim ID_KONSUMEN As String

' membuat kode otomatis berdasarkan isi dari tabel tb_konsumen
Private Sub ID_OTO()
Dim JUMLAH_REC As Integer
    
    BUKADATABASE
        REC.CursorLocation = adUseClient
        REC.Open "select * from tb_konsumen", CON, 1, 2
            If REC.RecordCount > 0 Then
                REC.MoveLast
                JUMLAH_REC = Val(Right(REC("id_konsumen"), 3) + 1)
            Else
                JUMLAH_REC = "01"
            End If

            If JUMLAH_REC < 10 Then
               txtKode.Text = "KS00" & CInt(JUMLAH_REC)
            ElseIf JUMLAH_REC < 100 Then
               txtKode.Text = "KS0" & CInt(JUMLAH_REC)
            ElseIf JUMLAH_REC < 1000 Then
               txtKode.Text = JUMLAH_REC
            End If
        REC.Close
        Set REC = Nothing
    TUTUPDATABASE
End Sub

' kode status objek sebagai validasi
Private Sub STATUS_OBJEK(NAVIGASI As String)
    Select Case UCase(NAVIGASI)
        Case UCase("NONE"):
            cmdSimpan.Enabled = True
            cmdTambah.Enabled = True
            cmdHapus.Enabled = False
        Case UCase("KLIK"):
            cmdSimpan.Enabled = False
            cmdTambah.Enabled = True
            cmdHapus.Enabled = True
    End Select
End Sub

' kode untuk menghapus data
Private Sub cmdHapus_Click()
If MsgBox("Apa anda yakin untuk menghapus Data ini ??", vbYesNo + vbQuestion, JUDUL) = vbYes Then
    
    BUKADATABASE
        REC.Open "DELETE from tb_konsumen where [id_konsumen] = '" & ID_KONSUMEN & "'", CON, 1, 2
    TUTUPDATABASE
    
    TAMPIL_DATA
    STATUS_OBJEK "none"
End If
End Sub

' kode untuk menyimpan data
Private Sub cmdSimpan_Click()
Dim PESAN As String

' mengecek apakah data belum terisi, dan jika belum terisi maka akan muncul pesa pemberitahuan
    If txtKode.Text = "" Then
        PESAN = PESAN & "Kode konsumen" & vbCrLf
    End If
    If txtNama.Text = "" Then
        PESAN = PESAN & "Nama konsumen" & vbCrLf
    End If
    If txtAlamat.Text = "" Then
        PESAN = PESAN & "Alamat konsumen" & vbCrLf
    End If
    If txtTelp.Text = "" Then
        PESAN = PESAN & "Telepon konsumen" & vbCrLf
    End If
    
    If Len(PESAN) > 3 Then
        MsgBox "Harap lengkapi data berikut:" & vbCrLf & vbCrLf & PESAN, vbInformation + vbOKOnly, JUDUL
        Exit Sub
    End If
    
    BUKADATABASE
        REC.Open "SELECT * FROM tb_konsumen", CON, 1, 2
        REC.AddNew
            REC("id_konsumen") = Trim(txtKode.Text)
            REC("nm_konsumen") = Trim(txtNama.Text)
            REC("alamat") = Trim(txtAlamat.Text)
            REC("telp") = Trim(txtTelp.Text)
        REC.Update
        REC.Close
    TUTUPDATABASE
    
    TAMPIL_DATA
    MsgBox "Data telah berhasil disimpan", vbInformation + vbOKOnly, "Info"
    BERSIH
End Sub

' kode untuk menambah data abru
Private Sub cmdTambah_Click()
    BERSIH
    TAMPIL_DATA
End Sub

Private Sub Form_Load()
    TAMPIL_DATA
    ID_OTO
    STATUS_OBJEK "NONE"
End Sub

' kode untuk menampilkan data
Private Sub TAMPIL_DATA()
I = 1

    LsKonsumen.ListItems.Clear
    
    BUKADATABASE
        REC.Open "select * from tb_konsumen ", CON, 1, 2
        Do While Not REC.EOF
            LsKonsumen.ListItems.Add I, , REC("id_konsumen")
            LsKonsumen.ListItems(I).ListSubItems.Add 1, , REC("nm_konsumen")
            LsKonsumen.ListItems(I).ListSubItems.Add 2, , REC("alamat")
            LsKonsumen.ListItems(I).ListSubItems.Add 3, , REC("telp")
            REC.MoveNext
            I = I + 1
        Loop
    TUTUPDATABASE
    
    BERSIH
End Sub

' untuk membersihkan form
Private Sub BERSIH()
    txtKode.Text = ""
    txtNama.Text = ""
    txtAlamat.Text = ""
    txtTelp.Text = ""
    ID_OTO
    STATUS_OBJEK "NONE"
End Sub

' kode untuk memilih data yang sudah tersimpan dalam database(tb_konsumen)
Private Sub LsKonsumen_ItemClick(ByVal Item As MSComctlLib.ListItem)
    STATUS_OBJEK "Klik"
    If Item.Selected = True Then
        txtKode.Text = Item.Text
        txtNama.Text = Item.ListSubItems(1).Text
        txtAlamat.Text = Item.ListSubItems(2).Text
        txtTelp.Text = Item.ListSubItems(3).Text
        
        ID_KONSUMEN = txtKode.Text
    End If
End Sub

buat 1 module dengan nama Module1.bas

Public CON As New ADODB.Connection
Public REC As New ADODB.Recordset

Sub BUKADATABASE()
On Error GoTo SOLUSI
    CON.Open "DSN=dsnKode", "", ""
SOLUSI:
    Select Case Err.Number
        Case 3705:
        CON.Close
        Exit Sub
    End Select
End Sub

Sub TUTUPDATABASE()
    CON.Close
End Sub

sebelum menjalankannya pastikan anda sudah membuat DSN nya dengan nama dsnKode. jika ada yg belum tau berikut step by stepnya:
masuk ke Control Panel lalu pilih Administrative Tools dan pilih Data Sources (ODBC), dan pilih Add maka akan muncul tampilan seperti dibawah ini:

lalu isi Data Source Name dengan nama dsnKode, lalu Pilih database dengan meng-klik Select dan cari lokasi database yang telah anda buat sebelumnya. jika sudah klik OK.
artikel ini serba minimalis, jadi silahkan anda kembangkan sesuai kebutuhan dan keinginan anda. good luck !!
anda bisa download contoh projectnya disini.