Macro Excel con base de datos Sql

Tengo una macro excel con base de datos SQL, funciona bien, PERO, el problema es que por cada consulta que hace la macro me vuelve a pedir que acepte la base de datos de donde necesito sacar la información, y eso aunque haya sólo una base de datos SQL corriendo igual me pide por cada consulta que pinche la base de datos para extraer la información.
Trabajamos con excel 2003 y SQL Anywher 10
Me aparace el cuadro SELECCIONAR ORIGEN DE DATOS,
SELECCIONO LA BASE DE DATOS
ACEPTO
HACE LA EXTRACCIÓN Y AL SIGUIENTE PASO ME VUELVE A MOSTRAR
SELECCIONAR LA BASE DE DATOS y así sucesivamente hasta que termina de correr la macro.
¿Qué puedo hacer para que consulte la base de datos sóla una vez?
Mi correo [email protected]
Te pido ayuda Por favor es para mi trabajo.
Te agrego la macro, la base de datos que consulta se llama Pmariano o la que corresponada a la escuela, y como bien te pude explicar debo presionar el origen a cada consulta que realizo.
Sub reports_weekly()
    Application.Goto Reference:="Macro_Color"
    Macro_Color = Selection.Value
   ' Macro_Color = 10
   ' recuperar parametros de fecha
    Application.Goto Reference:="week"
    nro_week = Right("00" & Trim(Str(Selection.Value)), 2)
   'Application.Goto Reference:="month"
   'nro_month = Selection.Value
    Application.Goto Reference:="year_wk"
    nro_year = Right("00" & Trim(Str(Selection.Value)), 2)
    ' activar pagina de sql
    Sheets("Sqls").Select
    ' inq by source
    Range("inq_source").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' app by source
    Range("app_source").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' int by source
    Range("int_source").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' enr by source
    Range("enr_source").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' total inq
    Range("tot_inq").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' total app
    Range("tot_app").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' total int
    Range("tot_int").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' total enr
    Range("tot_enr").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' Walk-In Inq, Int, Enr
    Range("winq").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
     ' total enr
    Range("wint").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
     ' total enr
    Range("wenr").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    Application.Goto Reference:="inq_code"
    Selection.Copy
    Range("An30:An50").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Goto Reference:="buscar_inq"
    Selection.Copy
    Range("AO30:AO50").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Goto Reference:="app_code"
    Selection.Copy
    Range("As30:As50").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Goto Reference:="buscar_app"
    Selection.Copy
    Range("At30:At50").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Goto Reference:="int_code"
    Selection.Copy
    Range("Ax30:Ax50").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Goto Reference:="enr_code"
    Selection.Copy
    Range("bc30:bc50").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Goto Reference:="buscar_enr"
    Selection.Copy
    Range("bd30:bd50").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ' weekly_lesson_lecciones=
    Range("weekly_lesson_lecciones").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' weekly_lesson_platas=
    Range("weekly_lesson_platas").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' weekly_enrollment=
    Range("wk_enrollment").Select
    Selection.QueryTable.Connection = "ODBC;DSN=LCMS2;UID=DBA;PWD=SQL;"
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' weekly_lecc_contratadas=
   ...
Respuesta
1
Estoy intentando replicar lo que haces en tu código y no me da el problema que indicas.
He creado dos tablas en una hoja de excel con datos obtenidos de Sql Server. Cuando le pido que las actualice lo hace sin problemas.
Lo único que he visto, supongo que ya lo habrás probado de todo, es que en las 'propiedades de rango de datos externos' puedes marcarle que guarde la definición de la consulta y la contraseña.
Si no consigues importar los datos de esa manera, podrías traerte los datos de cada tabla usando un sencillo procedimiento que podría ser este:
Sub importarDatos(ByVal conexion As String, ByVal usuario As String, _
                  ByVal password As String, ByVal sql As String, _
                  ByVal nomHojaDestino As String, _
                  ByVal nLinIni As Integer, ByVal nColIni As Integer)
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim i As Integer
    Dim nLin As Integer
    Dim miHoja As New Worksheet
    ' Abrimos la conexión y el recordset
    cn.Open conexion, usuario, password
    rs.Open sql, cn, adOpenDynamic, adLockReadOnly
    ' Seleccionamos la hoja destino
    Set miHoja = Sheets(nomHojaDestino)
    miHoja.Select
    ' Copiamos los datos de la cabecera
    For i = 0 To rs.Fields.Count - 1
        miHoja.Cells(nLinIni, nColIni + i) = rs.Fields(i).Name
    Next i
    ' Y ahora copiamos los datos
    nLin = nLinIni
    If Not rs.EOF Then rs.MoveFirst
    Do While Not rs.EOF
        nLin = nLin + 1 ' En la siguiente línea
        If nLin Mod 10 = 0 Then miHoja.Cells(nLin, nColIni).Select
        For i = 0 To rs.Fields.Count - 1
            DoEvents    ' Para que podamos ver lo que hace
            If Not IsNull(rs.Fields(i).Value) Then  ' Si viene a nulo ponemos blanco
                miHoja.Cells(nLin, nColIni + i) = rs.Fields(i).Value
              Else
                miHoja.Cells(nLin, nColIni + i) = ""
            End If
        Next i
        rs.MoveNext
    Loop
    ' Cerramos todo
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
End Sub
Tendrías que incluir la referencia a la librería 'Microsoft ActiveX Data Object xxx Library".
Siento no poder darte una respuesta más concreta.

1 respuesta más de otro experto

Respuesta
1
Sabes que lo mio es excel intermedio, y de macros me declaro ignorante...
Un consejo... la que es seca es ELSAMATILDE... ahi tendras una respuesta 100% fiable.
Slds.
A y no olvides cerrar esta consulta.
Themanky

Añade tu respuesta

Haz clic para o