Hadeh..hadeh...asli mumet...
..
Saya coba endapkan dulu ya mas,.....(dari dulu diendapkan terus....hehehehe)
Terima kasih Mas Hari...
..Saya coba endapkan dulu ya mas,.....(dari dulu diendapkan terus....hehehehe)
Terima kasih Mas Hari...
From: hari yanto <har_i20002000@yahoo.com>
To: belajar-access@yahoogroups.com
Sent: Wednesday, July 11, 2012 11:02 AM
Subject: Re: Bls: [belajar-access] Excute Store Procedure Di Access
Bismillahir rahmanir rahim.... Kita tinggal memodifikasi dengan cara membuat/menghapus tabel temporer > Memasukkan data hasil SP ke tabel temporer. Gambaran scriptnya seperti ini: 1. Letakkan script ini di module (karena akan digunakan untuk umum), untuk mendefinisikan nama komputer user: Option Explicit '*********** Code Start ************ ' This code was originally written by Terry Kreft. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Terry Kreft ' Public Const IDC_APPSTARTING = 32650& Public Const IDC_HAND = 32649& Public Const IDC_ARROW = 32512& Public Const IDC_CROSS = 32515& Public Const IDC_IBEAM = 32513& Public Const IDC_ICON = 32641& Public Const IDC_NO = 32648& Public Const IDC_SIZE = 32640& Public Const IDC_SIZEALL = 32646& Public Const IDC_SIZENESW = 32643& Public Const IDC_SIZENS = 32645& Public Const IDC_SIZENWSE = 32642& Public Const IDC_SIZEWE = 32644& Public Const IDC_UPARROW = 32516& Public Const IDC_WAIT = 32514& Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" _ (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long Declare Function LoadCursorFromFile Lib "user32" Alias _ "LoadCursorFromFileA" (ByVal lpFileName As String) As Long Declare Function SetCursor Lib "user32" _ (ByVal hCursor As Long) As Long 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() 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 2. Buat fungsi lihat tabel temporer. Bila ada, hapus. Bila tidak ada, cipatakan baru: Private Sub tb() Dim rbs As Recordset Dim db As Database Set rbs = CurrentDb.OpenRecordset("SELECT MSysObjects.Name" _ & " FROM MSysObjects WHERE MSysObjects.Type= 1 And MSysObjects.Flags = 0" _ & " AND MSysObjects.Name='" & "CARI_" & KOM & "'") If Not rbs.EOF Then Set db = CurrentDb db.TableDefs.Delete "CARI_" & KOM db.Close Set db = Nothing End If rbs.Close Set rbs = Nothing DoCmd.RunSQL "CREATE TABLE MASALAH_" & KOM & " (nm Text(255);" End Sub 3. Buat fungsi pengubah tanda upperstrop sebagai error handle. Agar tidak menampilkan pesan error sewaktu dieksekusi via vba: Function ubah(xt) If xt <> "" Then ubah = "'" & SqlSafe(Trim(xt)) & "'" Else ubah = "Null" End If End Function Public Function SqlSafe(strInput As String) As String SqlSafe = Replace(strInput, "'", "''") SqlSafe = Replace(SqlSafe, """", """""") End Function 4. Pada module, buat fungsi koneksi ke database: Public conn As New ADODB.Connection Public Function connToDB(serverName As String, _ UserName As String, userPass As String, _ dbPath As String, dbName As String) Dim strCon As String On Error GoTo errHandle strCon = "DRIVER={MySQL ODBC 5.1 Driver};SERVER=" _ & serverName & ";DATABASE=" & dbName & ";" & _ "UID=" & UserName & ";PWD=" & userPass & ";OPTION=3" 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 Function KONEKSI() connToDB "ISI_DG_IP_SERVER/LOCALHOST", "ISI_USERNAME", "ISI_PASSWORD_MYSQL", 3306, "ISI_NAMA_DATABASE" End Function 5. Setelah semua perangkat siap, kita jalankan prosesnya (misal kita buat fungsi baru): Function AMBIL() Dim db As Database Dim rsp As ADODB.Recordset 'bila tabel temporer merupakan source dari sebuah combo, kita hilangkan dahulu source itu DoCmd.Hourglass True Combo_IDR = "" Combo_IDR.Visible = False Combo_IDR.RowSource = "" 'buat/hapus tabel temporer Call tb 'lakukan koneksi ke database KONEKSI If conn.State <> 0 Then 'jika koneksi sukses Set rsp = conn.Execute("call P1('" & text1 & "');") 'memanggil SP If Not rsp.EOF Then 'jika ada datanya Set db = CurrentDb 'membuka database lokal Ms Acces Do While Not rsp.EOF 'lakukan berulang-ulang sampai akhir db.Execute "INSERT INTO MASALAH_" & KOM _ & " Values(" & ubah(rsp.Fields(0)) & "')" rsp.MoveNext Loop db.Close Set db = Nothing End If End if conn.Close Set conn = Nothing 'letakkan hasil tabel temporer ke combo box Combo_IDR.RowSource = "MASALAH_" & KOM Combo_IDR.Visible = True Combo_IDR.Requery DoCmd.Hourglass False End Function 6. Jalankan fungsi ambil Semoga bisa membantu, bermanfaat dan memberi semangat. Hariyanto (Surabaya) http://110.139.57.19/ --- On Tue, 10/7/12, Hendra Agestha Hamid <the_agestha@yahoo.com> wrote:
|
__._,_.___
SPAM IS PROHIBITED
.
__,_._,___
No comments:
Post a Comment