自动化Excel-SQL连接的更新以生成多个仪表板

Question

我正在生产我们产品子集的报告。这些产品中的每一个都有使用Excel在仪表板中显示的A4页面。

我有许多存储过程，Excel用于连接到我的数据库并返回数据。然后，仪表板自动更新此数据。

我需要为100多种产品中的每种产品生产此仪表板，然后将它们组合成一个文档。

但是，要更新数据，我当前必须进入每个存储过程连接并手动更新产品ID。这是一个缓慢的任务。

有没有一种方法可以使用SQL，Excel或VBA改进此过程？

也许是读取产品ID列表的VBA部分，依次更新每个存储过程，将仪表板平面保存为PDF并重复？

编辑：Excel使用存储过程通过"数据"选项卡下的内置连接工具连接到数据。

Answer 1

这是使用productid从头开始创建SQL查询的存根：

sql = "SELECT * FROM Table1 WHERE PRODUCT_ID = " & productId
If IsMissing(trustedConnection) Then
   sConn = "OLEDB;Provider=SQLOLEDB;Data Source=" & _
                serverInstance & ";Initial Catalog=" & database & _
                ";User ID=" & userId & ";Password=" & password & ";"
Else
   sConn = "OLEDB;Provider=SQLOLEDB;Data Source=" & _
   serverInstance & ";Integrated Security=SSPI;Initial Catalog=" & _
            database & ";"
End If
'Output worksheet
Set wks = Target.Parent
With qt
    .CommandType = xlCmdSql
    .CommandText = sql
    .Name = sName
    .RefreshStyle = xlOverwriteCells
    .Refresh BackgroundQuery:=False 'Execute SQL
End With
Set qt = wks.QueryTables.Add(Connection:=sConn, Destination:=Target)

现在只需创建一个循环和根据需要创建尽可能多的工作表和这些SQL查询。

Answer 2

这应该为您提供帮助：

    Sub SQL_Multi()
    '
    Dim RqSql As String, _
        RqSql = RqSql_Part1 & DicArt(i) & RqSql_Part2
        RqSql = RqSql_Part1 & DicArt(i) & RqSql_Part2
        DicArt()
    ReDim DicArt(0)
    'create or get the article list here (you can use Add_Array_To_Dico described below)
    DicArt = Add_Array_To_Dico(Array_Articles, DicArt, 1, True)

        'Add a new connection
        'Workbooks("base.xlsx").Connections.AddFromFile "D:DocumentsDEMO.odc"
'Set your query here
RqSql_Part1 = "Select * from DataBase where ID='"
RqSql_Part2 = "' and ...."
For i = LBound(DicArt) + 1 To UBound(DicArt)
        'Here is where the query is made for each ID
        RqSql = RqSql_Part1 & DicArt(i) & RqSql_Part2         '"article reference" : you can change here to place correctly the article
        With ActiveWorkbook.Connections("DEMOtest").ODBCConnection
            .BackgroundQuery = True
            .CommandText = Array(RqSql)
            .CommandType = xlCmdSql
            .Connection = "ODBC;DSN=DEMO;UID=ID;PWD=PWD;APP=Microsoft Office 2013;WSID=CHA02KW;DATABASE=DEMO"
            .RefreshOnFileOpen = False
            .SavePassword = True
            .SourceConnectionFile = ""
            .SourceDataFile = ""
            .ServerCredentialsMethod = xlCredentialsMethodIntegrated
            .AlwaysUseConnectionFile = False
        End With
        'Refreshing connection
        ActiveWorkbook.Connections("DEMOtest").Refresh
        'Wait long enough for refreshing to be finished (5 secs here)
        DoEvents
        Application.Wait (Now + TimeValue("0:00:05"))
        DoEvents
        Sheets("Dashboard").Calculate
        DoEvents
        'Export to Pdf (correct Filename)
        Sheets("Dashboard").ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=ThisWorkbook.Path & "AllMains " & DicArt(i) & ".pdf", _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
    Next i
    End Sub

和自定义功能以获取具有独特出现的数组：

Public Function Add_Array_To_Dico(ByVal ArrayT As Variant, _
                                    ByVal DicoArray As Variant, _
                                    Optional ByVal ColIndex As Integer, _
                                    Optional ByVal HasHeaders As Boolean) _
                                    As Variant
Dim A()
ReDim A(0)
Dim IsInDico As Boolean
Dim CellCont As String
Dim StartRow As Integer
If IsMissing(HasHeaders) Then
    'consider there is no headers
    StartRow = 0
Else
    If HasHeaders Then
        StartRow = 1
    Else
        StartRow = 0
    End If
End If
For i = StartRow To UBound(ArrayT, 1)
    CellCont = ArrayT(i, ColIndex)
    IsInDico = False
    For k = LBound(DicoArray) To UBound(DicoArray)
        If CellCont <> DicoArray(k) Then
        Else
            'Matched with dictionnary
            IsInDico = True
            Exit For
        End If
    Next k
    If IsInDico <> False Then
        'Already in Dictionnary
    Else
        'Add in Dictionnary
        ReDim Preserve DicoArray(UBound(DicoArray) + 1)
        DicoArray(UBound(DicoArray)) = CellCont
    End If
Next i
Add_Array_To_Dico = DicoArray
End Function