2017-02-16 91 views
1

此事很难解释,但更容易看到。我试图编写一个动态的用于从访问到Excel的quertytable。这样用户可以选择他们想要查询的文件,表格,属性和日期过滤器。将项目添加到具有某些项目确定的数组中VBA

这是怎样将Excel的看向管理查询(可以改变的,但可以处理):

Excel

这是代码,当我录制宏,而这样做的东西:

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array(_ 
     "ODBC;DSN=MS Access Database;DBQ=Z:\Informes de actividad\BBDD\2017\BBDD_ADIF_2017.accdb;DefaultDir=Z:\Informes de actividad\BBDD\201" _ 
     ), Array("7;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;")), _ 
     Destination:=Range("$A$1")).QueryTable 
     .CommandText = Array(_ 
     "SELECT PREVISIONES.Centro, PREVISIONES.`Skill Nombre`, PREVISIONES.Fecha, PREVISIONES.Tramo, PREVISIONES.`Prevision Recibidas Cliente`, PREVISIONES.`Prevision Atento`, PREVISIONES.`Prevision Recibidas`, PREVISI" _ 
     , _ 
     "ONES.`Prevision Atendidas`, PREVISIONES.`Prevision TMO`, PREVISIONES.`Prevision de Ocupacion s/Requeridos`, PREVISIONES.`Prevision de Ocupacion s/Programados`" & Chr(13) & "" & Chr(10) & "FROM `Z:\Informes de actividad\BBDD\2017" _ 
     , _ 
     "\BBDD_ADIF_2017.accdb`.PREVISIONES PREVISIONES" & Chr(13) & "" & Chr(10) & "WHERE (PREVISIONES.Fecha>{ts '2017-02-01 00:00:00'} And PREVISIONES.Fecha<{ts '2017-03-01 00:00:00'})" _ 
     ) 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .BackgroundQuery = True 
     .RefreshStyle = xlInsertDeleteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .PreserveColumnInfo = True 
     .ListObject.DisplayName = "Tabla_Consulta_desde_MS_Access_Database" 
    End With 
End Sub 

这就是我所做的得到它动态:

Sub Macro2() 

    Dim QT As QueryTable, wsPr As Worksheet, Año As String, Ruta As String, Archivo As String, Tabla As String, _ 
    FechaInicio As Date, FechaFin As Date, TablaPropiedades As String, CPropiedades As Collection, i As Integer, _ 
    Propiedades As String 

    Set wsPr = ThisWorkbook.Worksheets("Previsiones") 
    Set CPropiedades = New Collection 
    Año = "2017" 
    Ruta = "Z:\Informes de actividad\BBDD\" & Año 
    Tabla = "BBDD_ADIF_2017" 
    Archivo = "\" & Tabla & ".accdb" 
    TablaPropiedades = "PREVISIONES" 
    FechaInicio = Sheets("Hoja69").Range("C2").Value 
    FechaFin = Sheets("Hoja69").Range("C3").Value 


    For i = 0 To 10 
     CPropiedades.Add (TablaPropiedades & "." & Sheets("Hoja69").Cells(i + 2, 2).Value) 
    Next i 
    For i = 0 To CPropiedades.Count - 1 
     If i = 0 Then Propiedades = " " & CPropiedades(i + 1) 
     If i <> 0 And i <> CPropiedades.Count Then Propiedades = Propiedades & ", " & CPropiedades(i + 1) 
     If i = CPropiedades.Count Then Propiedades = ", " & Propiedades + CPropiedades(i + 1) 
    Next i 



    With wsPr.ListObjects.Add(SourceType:=0, Source:=Array(Array(_ 
     "ODBC;DSN=MS Access Database;DBQ=" & Ruta + Archivo & ";DefaultDir=" & Ruta) _ 
     , Array("DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;")), _ 
     Destination:=wsPr.Range("$A$1")).QueryTable 

     .CommandText = Array("SELECT " & Propiedades & Chr(13) & "" & Chr(10) & _ 
     "FROM `" & Ruta + Archivo & "`.PREVISIONES PREVISIONES" & Chr(13) & "" & Chr(10) & _ 
     "WHERE (PREVISIONES.Fecha>{ts '" & Format(FechaInicio, "yyyy-mm-dd") & " 00:00:00'}" & _ 
     "And PREVISIONES.Fecha<{ts '" & Format(FechaFin, "yyyy-mm-dd") & " 00:00:00'})") 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .BackgroundQuery = True 
     .RefreshStyle = xlInsertDeleteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .PreserveColumnInfo = True 
     .ListObject.DisplayName = "Previsiones" 
    End With 
    Call ActualizarPrevisiones 
    wsPr.Cells.ClearFormats 

End Sub 

宏在.CommandText行失败,我想因为即时插入所有propierties作为一个项目,每个属性应该是1项目。事情是...我怎么能在那里添加我的集合中的每个项目作为数组的一个项目(并不总是相同数量的collecions)。

我找不到从使用集合从头开始创建数组的任何事情......但这不是我想要的,我相信。

有人可以给我一个小费继续前进吗?谢谢!

回答

0

没有人,只是没有Array的.CommandText,只是在那里的一切,它的工作就像一个魅力......无论如何谢谢你阅读。