Mas Hariyanto, cara yang mas kasih sudah sy copa terapkan tapi saya menemui error sbb:
Sebagai informasi tambahan BE-nya ada LAN dengan IP 10.12.0.2, apakah betul jika baris berikut sy ganti sbb:
Function KONEKSI()
'connToDB txtServer, txtUID, txtPWD, 3306, txtDb
connToDB "localhost", "root", "admin", 3306, "Nama_database"
End Function
Menjadi :
Function KONEKSI()
'connToDB txtServer, txtUID, txtPWD, 3306, txtDb
connToDB "10.12.0.2", "root", "admin", 3306, "Production"
End Function
Best Regards
CW
From: belajar-access@yahoogroups.com [mailto:belajar-access@yahoogroups.com]
Sent: 01 Agustus 2016 12:02
To: belajar-access@yahoogroups.com
Subject: RE: [belajar-access] Query Union Error ketika tabel terkoneksi ke MySql
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: "Cecep" <cepwahyu@gmail.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (10) |
