How to connect to SQL Server from VBA use ADO
I have written the code to help connect to *.mdb. It's OK. Now I have to convert to the function to connect to SQL Server. Anyone have any suggestion? Please see my code as following:
[vba]
Option Explicit
Private Const mcsModName = "mDatabase" 'i.e Module Const String
Private Const msFILE_ERROR_LOG As String = "Error.log"
Public Enum eConnection
eSuccess = 1 'Connect success
eDefeat = 0 'Connect failure
End Enum
Public Enum eDeleteTable
eSuccess = 1 'Delete success
eDefeat = 0 'Delete failure
End Enum
'Store the status when checking the user in the table
Public Enum eUserExist
eUserDoesNotExist = 0 'The user does not exist
eUserExist = 1 ' The user exist
eCanNotConnect = -1 ' Can not connect to the database
eOthersError = -2 'Others errors
End Enum
Public Enum CommandTypeEnum
adCmdFile = 256 '(&H100)
adCmdStoredProc = 4
adCmdTable = 2
adCmdTableDirect = 512 '(&H200)
adCmdText = 1
adCmdUnknown = 8
End Enum
'---------------------------------------------------------------------------------------
' Procedure : GetConStr
' DateTime : 11/07/2008
' Author : Le Van Duyet
' Purpose : To get the connection string
' _ If you use DSN, then you pass this Argument to this function
' and sUserName, sPass also
'
' Please take note that we suppost our database is *.mdb
'
' Result : vbNullString if there is any error
' otherwise return the Connection String
'---------------------------------------------------------------------------------------
'
Private Function GetConStr(Optional sDSNname As String = vbNullString, _
Optional sUserName As String = vbNullString, _
Optional sPass As String = vbNullString) As String
Dim sConnect As String
Dim sDBPath As String, sDBFileName As String
Dim sSameFolder As String
On Error GoTo ErrorHandler
sDBFileName = GetIni("INF", "DATAFILENAME")
'If the user does not set up in the ini file
'Then get the constant in the mPublicConst module
If sDBFileName = vbNullString Then
sDBFileName = mcsDBFileName
End If
'Check, database is same folder with thisworkbook or not
sSameFolder = GetIni("INF", "SAMEFOLDER")
'Define the sDBPath
If UCase$(sSameFolder) = "TRUE" Then
sDBPath = ThisWbPath & sDBFileName
Else
'If sSameFolder = vbNullString then
'sDBFileName must be the full path, i.e including the folder path also
sDBPath = sDBFileName
End If
'According to sDNSName to create the connection string
If Len(sUserName) = 0 Then
sUserName = "Admin"
End If
If Len(sDSNname) = 0 Then
'If the user call this funtion without sDSNname then
'Mean that use the database file Ms Access in the same folder
'with this Excel file
sConnect = "Driver={Microsoft Access Driver (*.mdb)}; " & "Dbq=" & sDBPath & "; " & _
"UID=" & sUserName & "; PWD=" & sPass & "; "
Else
sDSNname = GetIni("DSN", "DSN")
'First we get the DSN from ini file
'If DSN in ini file=vbNullString or the ini file does not exist
'Then set DSN = mcsDSN the constant of DSN in the mPublicConst module
If sDSNname = vbNullString Then
sDBPath = mcsDSN
Else
sDBPath = sDSNname
End If
'The OLE DB provider for ODBC is called MSDASQL
'MSDASQL i.e MircroSoft Data Access SQL
sConnect = "Provider=MSDASQL; DSN=" & sDBPath & _
"; UID=" & sUserName & "; PWD=" & sPass & ";"
End If
GetConStr = sConnect
ErrorExit:
Exit Function
ErrorHandler:
'If there is an error, set sCreateConStr = vbnullstring
GetConStr = vbNullString
If bCentralErrorHandler(mcsModName, "sCreateConStr") Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
'---------------------------------------------------------------------------------------
' Procedure : ConnectToDB
' DateTime : 10/07/2008 15:24
' Author : Le Van Duyet
' Purpose : To check the connection to the database
'---------------------------------------------------------------------------------------
'
Function ConnectToDB(Optional sDSNname As String = vbNullString, _
Optional sDBUserName As String = vbNullString, _
Optional sDBPass As String = vbNullString) As Long
'This function will return:
' 1: Connect is successfull
' 0: Can not connect to database or error
'The ObjectStateEnum constants defined in ADO
'.adStateClosed | 0 - Means the connection is closed
'.adStateOpen | 1 - Means the connection is open
'.adStateConnecting | 2 - Means the object is in the process of making a connection
'.adStateExecuting | 4 - Means the connection is executing a command
'.adStateFetching | 8
Dim sConnect As String, sUseDNS As String
Dim lAttempt As Long
On Error GoTo ErrorHandler
'Check the gcnAcess before open
'gcnAccess.State = ObjectStateEnum.adStateOpen is openning
'Not gcnAccess Is Nothing, we have create the gcnAccess variable
Set gcnAccess = CreateObject("ADODB.Connection")
'Suppose that can not connect to database
'Gia su rang khong the ket noi voi CSDL
ConnectToDB = eConnection.eDefeat
'Get the data from setup file ini
'If when calling this function the programmer does not pass the sDSNname
If Len(sDSNname) = 0 Then
sUseDNS = GetIni("DSN", "DSN")
End If
'Get user name to connect to database
If Len(sDBUserName) = 0 Then
sDBUserName = Decrypt(GetIni("INF", "USERDB"))
End If
'Get pass to connect to database
If Len(sDBPass) = 0 Then
sDBPass = Decrypt(GetIni("INF", "PASSDB"))
End If
'Get the connection string
sConnect = GetConStr(sDSNname, sDBUserName, sDBPass)
If Len(sConnect) = 0 Then
'If sConnect = vbNullString, then can not connect to database
GoTo ErrorExit
End If
With gcnAccess
.Mode = 3 'i.e adModeReadWrite
'Neu sau thoi gian nay ma khong ket noi duoc se bao loi
'If after this time pass, the error come out
.ConnectionTimeout = 30
'CursorTypeEnum
'adOpenDynamic = 2
'adOpenForwardOnly = 0
'adOpenKeySet = 1
'adOpenStatic =3
'The CursorLocationEnum:
'adUseClient = 3
'adUseServer = 2
.CursorLocation = 3 'adUseClient
.ConnectionString = sConnect
.Open
End With
ConnectToDB = eConnection.eSuccess
'Close the connection to enable connection pooling
gcnAccess.Close
ErrorExit:
Exit Function
ErrorHandler:
'We will try to make the connection 3 times before bailing out
If lAttempt < 3 And gcnAccess.Errors.Count > 0 Then
If gcnAccess.Errors(0).NativeError = 17 Then
lAttempt = lAttempt + 1
Resume
End If
Else
'If more than 3 times then
ConnectToDB = eConnection.eDefeat 'i.e can not connect to Database
End If
If bCentralErrorHandler(mcsModName, "ConnectToDB", , False) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
[/vba]
Thanks,
Le Van Duyet
