k27: fungsi koneksi untuk beberapa database (Firebird, MySQL, Ms SQL Server dan Ms Access)

Public conn As ADODB.Connection

Public Enum TIPE_DATABASE
   FIREBIRD = 1
   MYSQL = 2
   SQLSERVER = 3
   MSACCESS = 4
End Enum

Public Function connToDB(ByVal tipeDb As TIPE_DATABASE, Optional ByVal serverName As String = "", _
   Optional ByVal userName As String = "", Optional ByVal userPass As String = "", _
   Optional ByVal dbPath As String = "", Optional ByVal dbName As String = "") As Boolean

   Dim strCon As String

   On Error GoTo errHandle

   Select Case tipeDb
      Case FIREBIRD
         strCon = "DRIVER=Firebird/Interbase(r) Driver;UID=" & userName & ";PWD=" & userPass & ";" & _
         "DBNAME=" & serverName & ":" & dbPath & "\" & dbName & ""

      Case MYSQL
         strCon = "DRIVER={MySQL ODBC 5.1 Driver};SERVER=" & serverName & ";DATABASE=" & dbName & ";" & _
         "UID=" & userName & ";PWD=" & userPass & ";OPTION=3"

      Case SQLSERVER
         strCon = "Provider=SQLOLEDB.1;User ID=" & userName & ";Pwd=" & userPass & ";" & _
         "Initial Catalog=" & dbName & ";Data Source=" & serverName & ""

      Case MSACCESS
        If Len(userPass) > 0 Then
           strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & dbPath & "\" & dbName & ";" & _
           "Jet OLEDB:Database Password=" & userPass & ""
        Else
           strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & dbPath & "\" & dbName & ""
        End If
   End Select

   Set conn = New ADODB.Connection
   conn.ConnectionString = strCon
   conn.Open

   connToDB = True

   Exit Function
errHandle:
   connToDB = False
End Function

Pada form tambahkan sebuah objek command dan set properties Name = cmdTesKoneksi

Private Sub cmdTesKoneksi_Click()
   Dim result  As Boolean

   'Firebird
   result = connToDB(FIREBIRD, "127.0.0.1", "SYSDBA", "masterkey", "d:\data", "db_akademik.fdb")
   Debug.Print result

   'MySQL
   result = connToDB(MYSQL, "127.0.0.1", "root", "masterkey", , "db_akademik")
   Debug.Print result

   'SQL Server 2000
   result = connToDB(SQLSERVER, "127.0.0.1", "sa", "masterkey", , "db_akademik")
   Debug.Print result

   'Ms Access - tanpa password
   result = connToDB(MSACCESS, , , , "d:\data", "db_akademik.mdb")
   Debug.Print result

   'Ms Access - menggunakan password
   result = connToDB(MSACCESS, , , "masterkey", "d:\data", "db_akademik.mdb")
   Debug.Print result
End Sub