PDA

View Full Version : How to connect to SQL Server from VBA use ADO



levanduyet
10-14-2008, 10:57 PM
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:


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

Thanks,

Le Van Duyet

Oorang
10-15-2008, 12:05 AM
Hello,
That is very neat, structured code. What piece of info are you missing, do you just need to know the correct connection string? If so you will need to post what version of SQL Server is being used (7.0, 2000, 2005, 2008) and also if it's the Full, Compact, or Express version.

levanduyet
10-15-2008, 12:24 AM
Hello,
That is very neat, structured code. What piece of info are you missing, do you just need to know the correct connection string? If so you will need to post what version of SQL Server is being used (7.0, 2000, 2005, 2008) and also if it's the Full, Compact, or Express version.
Dear Oorang,
Thanks for your reply.
I would like to build another function to connect to SQL Server.
Something like :

Private Function GetConStr(Optional SQLVersion As enumSQLVersion=1, _
Optional sDSNname As String = vbNullString, _
Optional sUserName As String = vbNullString, _
Optional sPass As String = vbNullString) As String
and

Function ConnectToDB(Optional SQLVersion As enumSQLVersion=1, _
Optional sDSNname As String = vbNullString, _
Optional sDBUserName As String = vbNullString, _
Optional sDBPass As String = vbNullString) As Long
Thanks,

Le Van Duyet

Oorang
10-15-2008, 12:39 AM
Hi Duyet,
In order to put something like that together, I would need the version information as requested please. Thanks!

levanduyet
10-15-2008, 02:09 AM
Dear Oorang,
Thanks again.

SQL Server is being used 2000, 2005 for Full, Compact, or Express version.

I would like to buid a general function.

Regards,

Le Van Duyet

Oorang
10-15-2008, 03:12 AM
If you need to cover that many options then I think you are best pointed to this resource: http://www.connectionstrings.com/
It will give you the strings for all of the above.