¿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.

1 respuesta

Respuesta
1

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.

Disculpe no le aclaré, es para Access de 64 bits

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.

Muchas, pero muchas ¡Gracias! Eduardo realmente ratifica sus conocimientos avanzados en Access y PostgreSQL, necesitamos expertos de su nivel.

Ya lo adapté a mis necesidades y llevo 10 empresas en la nube con una sola aplicación de Access.

Gracias nuevamente.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas