在循环中动态运行字符串 VBA Access

如何解决在循环中动态运行字符串 VBA Access

[抱歉，我决定进行编辑以更好地理解我正在尝试做的事情]

是否可以动态运行字符串，如果可以，如何运行？

我想要做的是运行一个 VBA 循环，以便在第一条记录之后为每条记录构建一个 sql 联合。由于可能有 1 条记录到 100 条记录，我希望这是动态的，因此我不必限制条目数。

示例：如果我有 5 条记录，它会创建具有 4 个联合的 sql 查询。所有相同的数据等

我想做的是这个。当有人打开表格时，他们将输入一个包装编号列表，从中他们将选择每个包装编号下的报价范围（所有报价、促销或买家）。然后，当代码运行时，它会根据他们选择的报价范围为每个包装编号构建联合查询。然后输出会为他们提供该包装编号下这些优惠的所有数据。

这里是我的完整代码供参考：（我为篇幅道歉，但我认为有必要获得完整的图片）

Private Sub ReviewButton_Click()
Dim Owner As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdfPassthrough As QueryDef
Dim strSeasonsql As String
Dim strSeason As String
Dim strType As String

Owner = GetNamespace("MAPI").Session.CurrentUser.AddressEntry

        If Me.NewRecord = True Then
            Me!Owner.Value = Owner
        End If
        
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("RetailEntry")
'Set rs = CurrentDb.OpenRecordset("SELECT * FROM RetailEntry")

strSeason = [Forms]![Retail_Navigation]![NavigationSubform].[Form]![cboSeason]
strType = rs.Fields("Offer").Value '[Forms]![ReviewButton]![RetailEntry].[Form]![Offer].Value

On Error GoTo 1
1:

'Build Initial Query based on first record and make sure there are records
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'All Offers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs.Fields("Offer") = "All Offers" Then
        Strsql = "Set NoCount ON DROP TABLE #catcov; " _
            & "SELECT disTINCT mailyear,offer,description,firstreleasemailed,season_id,offer_type," _
            & "case when description like '%Promo%' then 'Promo' " _
            & "Else 'Buyer' end As addtype " _
            & "INTO #catcov " _

        strSELECT = "FROM supplychain_misc.dbo.catcov; " _
            & "SELECT disTINCT " _
            & "a.PackNum " _
            & ",a.Description " _
            & ",a.CatID " _
            & ",DATEPART(QUARTER,FirstReleaseMailed) as Quarter " _
            & ",a.Retone " _
            & ",a.Ret2 " _
            & ",a.ORIGINALRETAIL " _
            & ",a.discountReasonCode " _
            & ",b.Season_id " _
            & ",a.year " _
            & ",addtype "

        strFROM = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _

        strWHERE = "WHERE b.Offer_Type In('catalog','insert','kicker','statement insert','bangtail','onsert','outside ad') " _
            & " and b.Season_id = '" & strSeason & "' " _
            & " and (Case when b.FirstReleaseMailed >= cast(dateadd(day,+21,getdate()) as date) then 1 else 0 end) = 1 "

Strsql = Strsql & vbCrLf & strSELECT & vbCrLf & strFROM & vbCrLf & strWHERE

'Promo/Core
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ElseIf rs.Fields("Offer") = "Promo" Or rs.Fields("Offer") = "Buyer" Then
        Strsql = "Set NoCount ON DROP TABLE #catcov; " _
            & "SELECT disTINCT mailyear," _
            & "case when description like '%Promo%' then 'Promo' " _
            & "Else 'Buyer' end As addtype " _
            & "INTO #catcov " _
        
        strSELECT = "FROM supplychain_misc.dbo.catcov; " _
            & "SELECT disTINCT " _
            & "a.PackNum " _
            & ",addtype "
      
      strFROM = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _
      
      strWHERE = "WHERE b.Offer_Type In('catalog','outside ad') " _
            & " and b.Season_id = '" & strSeason & "' and b.addtype = '" & strType & "' " _
            & " and (Case when b.FirstReleaseMailed >= cast(dateadd(day,getdate()) as date) then 1 else 0 end) = 1 "

Strsql = Strsql & vbCrLf & strSELECT & vbCrLf & strFROM & vbCrLf & strWHERE
End If

'Build/Loop Unions for each record after the first
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rs.MoveNext
strType = rs.Fields("Offer").Value
Do Until rs.EOF = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'All Offers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs.Fields("Offer") = "All Offers" Then
        StrUnion = "UNION SELECT disTINCT " _
            & "a.PackNum " _
            & ",addtype "

        strFROMnxt = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _

        strWHEREnxt = "WHERE b.Offer_Type In('catalog',getdate()) as date) then 1 else 0 end) = 1 "

Strsql2 = StrUnion & vbCrLf & strFROMnxt & vbCrLf & strWHEREnxt

'Promo/Buyer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ElseIf rs.Fields("Offer") = "Promo" Or rs.Fields("Offer") = "Buyer" Then
        StrUnion = "UNION SELECT disTINCT " _
            & "a.PackNum " _
            & ",addtype "
      
      strFROMnxt = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _
      
      strWHEREnxt = "WHERE b.Offer_Type In('catalog',getdate()) as date) then 1 else 0 end) = 1 "

Strsql2 = StrUnion & vbCrLf & strFROMnxt & vbCrLf & strWHEREnxt
End If

'Move to next Record and loop till EOF
rs.MoveNext
Loop

'If there are no Records then error
Else
    MsgBox "There are no Pack Numbers Entered."
End If

'END QUERY
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Build Retail Bump File Pass Through Query
    db.QueryDefs.Delete "qryMaster"
    Set qdfPassthrough = db.createqueryDef("qryMaster")
    qdfPassthrough.Connect = "ODBC;DSN=SupplyChainMisc;Description=SupplyChainMisc;Trusted_Connection=Yes;DATABASE=SupplyChain_Misc;"
    qdfPassthrough.ReturnsRecords = True
    qdfPassthrough.sql = Strsql & vbCrLf & Strsql2

rs.Close
Set rs = nothing

DoCmd.OpenForm "SubCanButton"
DoCmd.OpenQuery "MasterQuery"

DoCmd.Close acForm,"ReviewButton"

End Sub

解决方法

首先，当您不包含 ALL 时，您会执行“union distinct”：

UNION ALL
SELECT DISTINCT ...

因此，由于您选择的记录看起来相同，因此只会返回一个。

其次，包括 ALL 与否，您的概念没有多大意义。为什么要联合很多相同的记录？即使它们只持有不同的 ID，它们似乎也是从同一个表中提取出来的，您只需一次查询即可。

第三，将日期值转换为日期值没有任何好处，因此：

cast(dateadd(day,+21,getdate()) as date)

可以简化为：

dateadd(day,getdate())