Cara Menampilkan Data Link Properties Dialog dengan VB6

Pada artikel kali saya akan membagikan sebuah trik yaitu bagaimana Cara Menampilkan Data Link Properties Dialog dengan VB6. Data Link ini biasanya sering kita gunakan saat kita mengkoneksikan sebuah database dengan menggunakan Properties pada Form vb6.

Ternyata kita jug bisa menampilkan Properties Dialog ini dengan menggunakan kode yang ada di vb6 ini. Berkut dibawah ini adalah kode untuk menampilkannya :

'simpan kode di bawah pada MODUL  

 

Public Function getADOConnectionString(Optional ByVal cnStringToEdit As String = "", Optional sPrePromptUserMessage As String = "") As String

 

  Dim sActivity As String

  Dim dl As Object

  Dim cn As Object

 

    On Error GoTo ErrGetAdoConnectionString

    sActivity = "Creating Datalinks object."

    Set dl = CreateObject("DataLinks")

    If Not "" = (cnStringToEdit) Then

        If Not "" = (sPrePromptUserMessage) Then

            MsgBox sPrePromptUserMessage, vbInformation, "Connecting to Database..."

        End If

        sActivity = "Creating ADODB.Connection object"

        Set cn = CreateObject("ADODB.Connection") 

        cn.ConnectionString = "Provider=SQLOLEDB.1;Initial Catalog=PUBS" 

        sActivity = "Prompting user to  edit  connect string"

        dl.PromptEdit cn

      Else

        sActivity = "Prompting user for  new  connect string"

        Set cn = dl.PromptNew()

    End If

 

    If cn Is Nothing Then

        getADOConnectionString = ""

        Exit Function

    End If

    getADOConnectionString = cn.ConnectionString

    Set cn = Nothing

Exit Function

 

ErrGetAdoConnectionString:

  Dim sMsg As String

    Set cn = Nothing

    sMsg = "Error While [" + sActivity + "].  Details are below: " + vbCrLf

    sMsg = sMsg + "Description:[" + Err.Description + "]." + vbCrLf

    sMsg = sMsg + "Source:[" & Err.Source & "]." + vbCrLf

    sMsg = sMsg + "Number:[" & Err.Number & "]." + vbCrLf

    sMsg = sMsg + "Help File:[" & Err.HelpFile & "]." + vbCrLf

    MsgBox sMsg, vbCritical, "Error Connecting to Database."

End Function


'simpan kode di bawah pada FORM 


Private Sub Command1_Click()

On Error GoTo ErrHandler

    Dim strCon As String

    strCon = getADOConnectionString()

    If strCon = "" Then Exit Sub

    'kode selanjutnya disini

    Exit Sub 

ErrHandler:

    MsgBox Err.Number & vbNewLine & Err.Description, vbExclamation + vbOKOnly, "Connection Error"

End Sub

Setelah anda menuliskan kode diatas coba jalankan Project Anda, jika tidak ada error maka hasilnya seperti pada gambar dibawah ini :

output
Demikian artikel singkat kali ini semoga bermanfat buat kita semua.Amin
Selamat mencoba semoga sukses....




No comments: