将项添加到具有确定VBA的一些项的数组中

时间:2017-02-16 11:55:55

标签: excel vba ms-access

这件事很难解释,但更容易看到。我正在尝试编写动态用于从访问到Excel的quertytable。这样,用户可以选择他们想要查询的文件,表格,属性和日期过滤器。

这是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行失败,我猜是因为我将所有的属性作为一个项目插入,每个属性应该是1个项目。事情是......我如何将我的集合中的每个项目添加为数组的项目(不会总是相同数量的集合)。

除了使用集合从头开始创建一个数组之外我找不到任何其他东西......但这不是我想要的东西。

有人可以给我一个提示继续吗?谢谢!

1 个答案:

答案 0 :(得分:0)

没关系,只是做了没有数组的.CommandText,只是那里的一切,它的工作就像一个魅力......感谢你的阅读。