1

tengo un problema en optimizar esta macro, la cuestión es que la utilizó en carpetas y archivos con nombre y ubicación diferentes, entonces cada vez que la voy a utilizar debe reemplazar la ruta manualmente entrado en el módulo de programación en vba, quiero poder que esto se haga de forma más automática es decir con un cuadro de diálogo o poder identificar la ruta según la ubicación del archivo access e incluirla en la línea necesaria, la macro que estoy utilizando es la siguiente

Sub consultarSIGSDM_SEN_CONTENIDO_TABLERO()
    Dim cn As Object
    Dim datos As Object
    Dim consultaSql  As String
    Dim conexion As String
    Dim cont As Long
    Set cn = CreateObject("ADODB.Connection")
    conexion = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=C:\Users\Hp\Desktop\ASIGNACION_MAYO_KR\192.168.100.105informacion_sdm_dcvtCTO_092_2007APROBADOS\ZE_06_126\ZE_06_126.mde"
    consultaSql = "Select * from SIGSDM_SEN_CONTENIDO_TABLERO;"
    cn.Open conexion
    Set datos = cn.Execute(consultaSql)
    cont = 3
    Do While Not datos.EOF
        Cells(cont, 3) = datos.Fields("INTERNO_TABLERO")
        Cells(cont, 4) = datos.Fields("INTERNO_SENAL").Value
        Cells(cont, 5) = datos.Fields("INTERNO_TIPO_FLECHA")
        Cells(cont, 6) = datos.Fields("INTERNO_LEYENDA")
        cont = cont + 1
        datos.MoveNext
    Loop
    datos.Close
    Set datos = Nothing
    cn.Close
    Set cn = Nothing
End Sub

2 respuestas 2

2

Bienvenido a SO.

Lo primero, crea una variable de tipo String en la que almacenarás la ruta, y la concatenas con tu código de conexión, por ejemplo, Dim RutaArchivo as String:

Luego, tendrías varias opciones para rellenar esa variable con la ruta:

  1. La más fácil, aunque quizás no la mejor, es usando un InputBox:

Dim RutaArchivo As String

RutaArchivo = InputBox("Pegar aquí la ruta completa al archivo, incluyendo la extensión.", "RUTA AL ARCHIVO", "C:\Users\Hp\Desktop\ASIGNACION_MAYO_KR\192.168.100.105informacion_sdm_dcvtCTO_092_2007APROBADOS\ZE_06_126\ZE_06_126.mde")

  1. Otra opción sería poniendo la ruta en una celda en Excel (si ejecutas desde ahí esta macro) y que se guarde en la variable. Algo en plan:

    Dim RutaArchivo As String
    RutaArchivo = Range("A1").Value
    

En ambos caso tendrías que modificar la parte de tu conexión, para concatenarla con tu variable RutaArchivo:

 conexion = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & RutaArchivo

Tienes más opciones, como Propiedad Application.FileDialog (Excel), pero quizás sea complicarte la vida (aunque el acabado es mejor). En Internet hay miles de ejemplos de cómo usarlo.

Si fuera por simpleza y facilidad, optaría por las 2 opciones que he mencionado.

1
  • Muchas gracias @ElierSánchez, voy a tratar con tus recomendación, a ver como me va con eso Commented el 13 may. 2020 a las 0:31
2

Comunidad SO, Queria compartirles el código de la solución que le di a mi problema,

Utilice la Propiedad Application.FileDialog (Excel), para obtener la ruta del archivo que quería utilizar en la macro de esta forma

Sub Obtenerrutadearcchivo()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Set a = Sheets("GEO_SEGMENTO")
a.Range("A1") = FileSelected
End Sub

Luego relaciones esta macro en la que obtengo mi ruta para ejecutar la consulta en access desde una tabla en excel

Sub consultarSIGSDM_MALLA_VIAL_IDU1()
    Dim cn As Object
    Dim datos As Object
    Dim consultaSql  As String
    Dim conexion As String
    Dim cont As Long
    Dim RutaArchivo As String
    Set a = Sheets("GEO_SEGMENTO")
    RutaArchivo = a.Range("A1").Value
    Set cn = CreateObject("ADODB.Connection")
    conexion = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & RutaArchivo
    consultaSql = "Select * from SIGSDM_MALLA_VIAL_IDU;"
    cn.Open conexion
    Set datos = cn.Execute(consultaSql)
    cont = 3
    Do While Not datos.EOF
        Cells(cont, 1) = datos.Fields("CIV")
        Cells(cont, 17) = datos.Fields("NOMENCLATURA_VIAL")
        Cells(cont, 18) = datos.Fields("NOMENCLATURA_VIAL_INICIAL")
        Cells(cont, 19) = datos.Fields("NOMENCLATURA_VIAL_FINAL")
        cont = cont + 1
        datos.MoveNext
    Loop
    datos.Close
    Set datos = Nothing
    cn.Close
    Set cn = Nothing
End Sub

eso seria todo. gracias por su aporte me fue de mucha utilidad y provecho.

1
  • 1
    Si esta es la solución entonces considera que esta sea la respuesta que quede marcada como aceptada
    – user128299
    Commented el 13 may. 2020 a las 15:38

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.