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

这个东西很难解释,但更容易看到。 我试图编写一个dynamic的使用从一个quertytable访问到Excel中。 这样,用户可以select他们想要查询的文件,表格,属性和datefilter。

这就是Excel将如何pipe理查询(可以改变,但可以处理):

高强

这是我在录制macros时的代码,

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 

这就是我所做的dynamic:

 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 

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

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

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

没关系的人,只是没有arrays的.CommandText,只是在那里的一切,它的工作就像一个魅力…感谢您阅读无论如何。