Wednesday, October 27, 2010

Re-usable codes - Connecting various data bases using VBA

Connect to Ms-Access Database
**********************************

Public Sub ConnecttoDatabase()
    Dim strConstr As String
    On Error GoTo errhandler
    strDatabasePath = ThisWorkbook.path & "\<databasename>"
    If objCon.State <> adStateClosed Then objCon.Close
    strConstr = "ODBC;DBQ=" & Databasepath & ";PWD=<pwd>;Driver={Microsoft Access Driver (*.mdb)}"
    objCon.ConnectionString = strConstr
    objCon.Open strConstr ' open the database connection
    Exit Sub
errhandler:
    MsgBox Err.Number & ": " & Err.Description, vbInformation + vbOKOnly, ThisWorkbook.Name
End Sub
--------------------------------------------------------------------------------------------------------
Connect to Excel
**********************************
Private Sub ConnectToExcel()
    Dim cn As New ADODB.Connection
    Dim strconn
    strconn = "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790;" & _
                "ReadOnly=1;DBQ=" & ThisWorkbook.path & "\<Excelfilename>" ' & ThisWorkbook.Name & ";"
    cn.Open strconn
   
    'Getting Records
    Dim rs As New ADODB.Recordset
    rs.Open "Select * from [sheetname$]", cn, adOpenDynamic, adLockOptimistic
   
    'Paste into Excel
    Range("A1").CopyFromRecordset rs
    MsgBox "Connected"
End Sub
-------------------------------------------------------------------------------------------------------------
'Connect to Oracle
**********************************
Private Sub ConnectToOracle()
    Dim cn As New ADODB.Connection
    Dim cmd As New ADODB.Command
          
    Dim strconn As String
    strconn = "Provider=MSDAORA;Data Source=<datasourcename>;User Id=<userid>;Password=<pwd>"
    cn.Open strconn
       
    'Getting Records
    Dim rs As New ADODB.Recordset
    rs.Open "Select * from <tablename>", cn, adOpenDynamic, adLockOptimistic
   
    'Paste into Excel
    Range("A1").CopyFromRecordset rs
    MsgBox "Connected"
End Sub
-------------------------------------------------------------------------------------------------------------
 'Connect to SQL Server
*************************
Public Sub ConnectToSQLSERVER()
    Dim cn As New ADODB.Connection
    cn.Open "provider=SQLOLEDB;server=" & <servername>& "; uid=<userid>.;pwd=<pwd.;Database=<databasename>"
       
    Dim cmd As New ADODB.Command
   
    'Getting Records
    Dim rs As New ADODB.Recordset
    cmd.ActiveConnection = cn
    cmd.CommandText = <tablename>    \
    cmd.CommandType = adCmdStoredProc
    Set rs = cmd.Execute
   
    'rs.Open "Select * from <tablename>", cn, adOpenDynamic, adLockOptimistic
   
    'Paste into Excel
    Range("A1").CopyFromRecordset rs
    MsgBox "Connected"
   
End Sub
---------------------------------------------------------------------------------------------------------
'Connect to Csv format
*************************
Public Sub ConnectToCsv()
    Dim cn As New ADODB.Connection
    Dim str As String
    cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & _
        ThisWorkbook.path
   
End Sub

No comments:

Post a Comment