¿Cómo se puede crear un DSN en Access con VBA?
Como dice el título de la pregunta, necesito vincular tablas de PostgreSQL con Access mediante ODBC, pero no quiero hacerlo manual por cada PC. Sino mediante una función o procedimiento en VBA.
Martha, no dice para que plataforma de Access 32 o 64 bits, porque el código es totalmente diferente.
Espero confirme para así darle una respuesta más objetiva, lo cierto es que esto lo utilizo frecuentemente cuando instalo aplicaciones de Access con PostgreSQL como backend en la nube.
Martha, le dejo este formulario que utilizo para cambiar de empresa en mis aplicaciones, esto permite que con una sola aplicación de Access pueda administrar varias empresas utilizando en la nube un servidor de datos PostgreSQL.
El formulario permite Crear, Editar y Retirar el DSN para la empresa seleccionada.
Copie este código en un módulo
'Módulo para CREAR, EDITAR Y ELIMINAR UN DSN 'ACCESS 64 BITS 'PREPARADO POR: Eduardo Pérez Fernández 'Fecha: 12/04/2023 Private Enum HKEY_PTR HKEY_LOCAL_MACHINE = &H80000002 End Enum Private Const SQL_FETCH_NEXT = 1 Private Const SQL_SUCCESS = 0 Private Declare PtrSafe Function SQLConfigDataSource Lib "ODBCCP32.DLL" ( _ ByVal hwndParent As LongPtr, _ ByVal fRequest As Long, _ ByVal lpszDriver As String, _ ByVal lpszAttributes As String) As LongPtr Private Const ODBC_ADD_DSN = 1 ' Agregar un nuevo DSN Private Const ODBC_CONFIG_DSN = 2 ' Modificar un DSN existente Private Const ODBC_REMOVE_DSN = 3 ' Eliminar un DSN existente Private Declare PtrSafe Function SQLAllocHandle Lib "odbc32.dll" ( _ ByVal HandleType As Integer, _ ByVal inputHandle As LongPtr, _ ByRef OutputHandlePtr As LongPtr) As Integer Private Declare PtrSafe Function SQLFreeHandle Lib "odbc32.dll" ( _ ByVal HandleType As Integer, _ ByVal handle As LongPtr) As Integer Private Declare PtrSafe Function SQLDrivers Lib "odbc32.dll" ( _ ByVal hEnv As LongPtr, _ ByVal fDirection As Integer, _ ByVal szDriverDesc As String, _ ByVal cbDriverDesc As Integer, _ ByRef pcbDriverDesc As Integer, _ ByVal szDriverAttributes As String, _ ByVal cbDriverAttributes As Integer, _ ByRef pcbDriverAttributes As Integer) As Integer Private Function DriverExists(driverName As String) As Boolean Dim hEnv As LongPtr Dim ret As Integer Dim driverDesc As String * 1024 Dim driverAttributes As String * 1024 Dim cbDriverDesc As Integer Dim cbDriverAttributes As Integer 'Inicializar el entorno ODBC ret = SQLAllocHandle(1, 0, hEnv) If ret <> 0 Then DriverExists = False Exit Function End If 'Buscar el controlador Ret = SQLDrivers(hEnv, 2, driverDesc, 1024, cbDriverDesc, driverAttributes, 1024, cbDriverAttributes) While ret = 0 If InStr(driverDesc, driverName) > 0 Then DriverExists = True Exit Function End If Ret = SQLDrivers(hEnv, 2, driverDesc, 1024, cbDriverDesc, driverAttributes, 1024, cbDriverAttributes) Wend 'Liberar los recursos utilizados SQLFreeHandle 1, hEnv End Function Public Function CreatePostgreSQLDSN(ByVal DSNName As String, _ ByVal ServerName As String, _ ByVal puerto As Long, _ ByVal DatabaseName As String, _ ByVal UserName As String, _ ByVal Password As String, tipo As Byte) As Boolean Dim lResult As LongPtr Dim sAttributes As String ' Construir la cadena de atributos del DSN sAttributes = "Server=" & ServerName & vbNullChar sAttributes = sAttributes & "Port=" & puerto & vbNullChar ' El puerto por defecto es 5432 sAttributes = sAttributes & "Database=" & DatabaseName & vbNullChar sAttributes = sAttributes & "Uid=" & UserName & vbNullChar sAttributes = sAttributes & "Pwd=" & Password & vbNullChar sAttributes = sAttributes & "Description=BaseDatosEmpresa" & vbNullChar If tipo = 1 Then ' Crear el DSN lResult = SQLConfigDataSource(0, ODBC_ADD_DSN, "PostgreSQL UNICODE", "DSN=" & DSNName & vbNullChar & sAttributes & vbNullChar) ElseIf tipo = 2 Then ' ' Modificar un DSN existente lResult = SQLConfigDataSource(0, ODBC_CONFIG_DSN, "PostgreSQL UNICODE", "DSN=" & DSNName & vbNullChar & sAttributes & vbNullChar) Else 'remover DSN lResult = SQLConfigDataSource(0, ODBC_REMOVE_DSN, "PostgreSQL UNICODE", "DSN=" & DSNName & vbNullChar & sAttributes & vbNullChar) End If If lResult <> 0 Then CreatePostgreSQLDSN = True End If End Function
CÓDIGO DEL BOTÓN DSN
Private Sub btnDSN_Click() Dim mDSN As Boolean If IsNull(Me.opcDSN) Then MsgBox "Debe indicar el proceso a realizar con el DSN", vbInformation, "Error ..." Exit Sub End If mDSN = CreatePostgreSQLDSN(Me.dsn, Me.servidor, Me.puerto, Me.basedatos, Me.usuario, Me.contrasena, Me.opcDSN) If mDSN Then If Me.opcDSN = 1 Then MsgBox "DSN creado satisfactoriamente", vbInformation, "DSN" ElseIf Me.opcDSN = 2 Then MsgBox "DSN editado satisfactoriamente", vbInformation, "DSN" Else MsgBox "DSN Eliminado satisfactoriamente", vbInformation, "DSN" End If End If End Sub
No olvide que en cada PC debe estar instalador el controlador ODBC de PostgreSQL.
Espero le sirva, como tiene mi correo puede enviarme sus comentarios o dudas.
- Compartir respuesta