Data Link Properties Dialog Box Cara Menampilkannya

'simpan kode di bawah pada modul Option Explicit 
 
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 

Contoh penggunaan fungsi di atas:

'simpan kode di bawah pada form Option Explicit 
 
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