Criar DSN via VBA

[May_C]

Ei gente,

Então, o tendo dificuldade de criar um DSN via código. O código é:

'################################################# API para criar DSN

Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal _

hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, _

ByVal lpszAttributes As String) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _

(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _

ByVal samDesired As Long, ByRef phkResult As Long) As Long

Const REG_SZ = 1

Const KEY_ALL_ACCESS = &H2003F

Const HKEY_CURRENT_USER = &H80000001

Const HKEY_LOCAL_MACHINE = &H80000002

Const ODBC_ADD_DSN = 1 '4 ' cria o DSN

Const ODBC_REMOVE_DSN = 3 '6 ' excluir o DSN

Private Const SQL_SUCCESS = 0

Private Const SQL_SUCCESS_WITH_INFO = 1

Private Const SQL_NO_DATA = 100

Private Const SQL_ERROR = (-1)

Private Const SQL_MAX_MESSAGE_LENGTH = 512

Sub Chamada()

Dim ret

'chamada da função

Call CriaDSN("Teste2", "192.168.11.95", "SQL Server", "eet", "eet")

End Sub

'#################################################

Sub CriaDSN(pDSN As String, pServer As String, pDataBase As String, pUsuario As String, pSenha As String)

Dim strAttributes As String

Dim sDBQ As String

Dim lngRet As Long

Dim hKey As Long

Dim regValue As String

Dim valueType As Long

' consulta o registro para verificar se o DSN já esta instalado

' abre a chave

If RegOpenKeyEx(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\" & pDSN, 0, KEY_ALL_ACCESS, hKey) = 0 Then

RegCloseKey hKey

Else

strAttributes = "SERVER=" & pServer & Chr$(0)

strAttributes = strAttributes & "DSN=" & pDSN & Chr$(0)

strAttributes = strAttributes & "DATABASE=" & pDataBase & Chr$(0)

'strAttributes = strAttributes & "UserName=" & pUsuario & Chr$(0)

strAttributes = strAttributes & "UID=" & pUsuario & Chr$(0)

strAttributes = strAttributes & "PWD=" & pSenha & Chr$(0)

'strAttributes = "UID = eet" & Chr$(0)

strAttributes = strAttributes & "WSID = PIMS01" & Chr$(0)

'strAttributes = strAttributes & "APP=Microsoft Data Access Components" & Chr$(0)

'strAttributes = strAttributes & "SERVER =192.168.11.95" & Chr$(0)

lngRet = SQLConfigDataSource(0&, ODBC_ADD_DSN, "SQL Server", strAttributes)

If lngRet <> 1 Then

MsgBox "Falha ao Criar Conexão com o Banco de Dados"

Else

MsgBox "Conexão com o Banco de Dados Concluida"

End If

End If

End Sub

O comando SQLConfigDataSource é o responsável pela criação do DSN, mas toda vez que rodo o programa ele retorna 0, indicando que o DSN não foi criado, alguém sabe como resolver?

Grata,

May