Begini...,
1. Buat modul koneksi dan nama komputer, karena akan di pakai di hampir semua form. Nama komputer digunakan untuk nama tabel biar unik antar masing-masing user
Ini scriptnya:
Option Explicit
Public conn As New ADODB.Connection 'deklarasi koneksi
Private Const MAX_COMPUTERNAME As Long = 15
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Private Function TrimNull(item As String)
'return string before the terminating null
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function
Function KOM()
'untuk membuat tabel berdasarkan nama komputer
Dim tas As String
'pre-load the text boxes with
'the local computer name for testing
tas = Space$(MAX_COMPUTERNAME + 1)
Call GetComputerName(tas, Len(tas))
KOM = TrimNull(tas)
If KOM Like "*-*" Then
KOM = Replace(KOM, "-", "_")
End If
End Function
Public Function connToDB(ServerName As String, _
UserName As String, userPass As Variant, _
dbPath As String, dbName As String)
Dim strCon As String
On Error GoTo errHandle
'sesuaikan driver mysqlnya, ada yang pakai 3.51
strCon = "DRIVER={MySQL ODBC 5.1 Driver};SERVER=" _
& ServerName & ";DATABASE=" & dbName & ";" & _
"UID=" & UserName & ";PWD=" & userPass & ";OPTION=16426"
Set conn = New ADODB.Connection
conn.Open strCon
Exit Function
errHandle:
MsgBox "SERVER SEDANG TIDAK AKTIF", , "NON AKTIF"
conn.Close
Set conn = Nothing
End Function
Public Function EscapeQuotes(s) As String
If s = "" Then
EscapeQuotes = ""
ElseIf Left(s, 1) = "'" Then
EscapeQuotes = "''" & EscapeQuotes(Mid(s, 2))
Else
EscapeQuotes = Left(s, 1) & EscapeQuotes(Mid(s, 2))
End If
End Function
Function hp_tb(n_tb)
Dim rbs As Recordset
Dim db As DAO.Database
'untuk menghapus tabel Access temporer
Set rbs = CurrentDb.OpenRecordset("SELECT MSysObjects.Name" _
& " FROM MSysObjects WHERE MSysObjects.Type= 1 And MSysObjects.Flags=0" _
& " and MSysObjects.Name='" & n_tb & "'") 'melihat nama tabel n_tb
If Not rbs.EOF Then 'bila ada record
Set db = CurrentDb 'menetapkan bahwa db adalah database ini
db.TableDefs.Delete n_tb 'hapus tabel
'menghilangkan dari memory komputer
db.Close
Set db = Nothing
End If
'menghilangkan dari memory komputer
rbs.Close
Set rbs = Nothing
End Function
Function KONEKSI()
'connToDB txtServer, txtUID, txtPWD, 3306, txtDb
connToDB "localhost", "root", "admin", 3306, "Nama_database"
End Function
2. Kita mulai bermain di form. Misal nama comboBoxnya contoh.Propertinya:
Control Source ==> kosongkan
Row Source Type ==> Table/query
Row Source ==> kosongkan
Coloum Count ==> 1
Coloum Head ==> No
3. Misal, event yang kita manfaatkan adalah saat, pertama kali loading.
Private Sub Form_Load()
Dim tb as Variant
Dim db As Database
Dim rsp As ADODB.Recordset 'deklarasi rsp sebagai ADODB recordset
KONEKSI 'melakukan koneksi
If conn.State <> 0 Then 'bila sudah konek
contoh.RowSource = "" 'menghilangkan recordsource dulu biar tidak error
contoh.Visible = False 'tidak ditampilkan dulu
tb = "temp_" & KOM 'nama tabel temporer yang akan kita buat
hp_tb (tb) 'hapus tabel temporer dulu bila sudah ada
'buat tabel temporer asumsi nama field=field1
'size 255
DoCmd.RunSQL "CREATE TABLE " _
& tb & " (field1 Text(255));"
'melihat data di tabel mysql
Set rsp = conn.Execute("SELECT left([Week_Subc],5)" _
& " From TblCultureProduction UNION" _
& " SELECT left([Week_Subc],5) From" _
& " TblCultureIncoming")
If Not rsp.EOF Then
DoCmd.Hourglass True
Set db = CurrentDb 'deklarasi db adalah currentdb
'mengisi record dengan --All--
db.Execute ("Insert into " _
& tb & " Values ('--All---')")
Do While Not rsp.EOF 'jika ada data, lakukan berulang sampai akhir
If rsp.Fields(0) <> "" Then 'jika record berisi
'isi tabel temporer dengan data Mysql
db.Execute ("Insert into " _
& tb & " Values ('" _
& EscapeQuotes(rsp.Fields(0)) _
& "')")
End If
rsp.MoveNext
Loop
db.Close
Set db = Nothing
DoCmd.Hourglass False
End If
rsp.Close
Set rsp = Nothing
contoh.RowSource = tb 'letakkan recordsource combo contoh
contoh.DefaultValue = """--All--""" 'menjadikan --All-- sebagai devault value
contoh.Visible = Trye 'Tampilkan
contoh.Requery 'refresh
Else
MsgBox "gagal koneksi"
End If
conn.Close 'menutup koneksi
Set conn = Nothing 'menghilangkan koneksi dari memori
End Sub
Semoga bisa membantu dan memberi semangat.
Hariyanto (Surabaya)
Posted by: hari yanto <har_i20002000@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (8) |
