如何从表格中填充报表中的未绑定文本？

Question

我每天都会向每位客户发送一份报告，回顾当天的情况。我没有为每个客户创建不同的报告，而是使用一个报告并更改用于提供报告的查询的 SQL Where 语句。我正在使用循环来更改查询，然后将链接的报告导出为 pdf 并通过电子邮件发送出去。我正在尝试以未绑定的文本获取客户的姓名作为报告的标题。我可以在循环过程中轻松获取客户姓名，但是如何在将报告中的未绑定文本框填充为客户姓名后，再将其导出为 pdf？

Public Function querydef()
Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
' Use basic (clear-text) authentication.
Const cdoBasic = 1
' Use NTLM authentication
Const cdoNTLM = 2 'NTLM

Set imsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields


    ' send one copy with SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = cdoSendUsingPort
flds.Item(schema & "smtpserver") = "smtp.gmail.com"
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = cdoBasic
flds.Item(schema & "sendusername") = "email.com"
flds.Item(schema & "sendpassword") = "abc"
flds.Item(schema & "smtpusessl") = True
flds.Update

Dim Files As Variant
Dim WhereQ As String
Dim db As DAO.Database
Set db = CurrentDb
Dim qdf As DAO.querydef

Set MYDB = CurrentDb
Set myrec = MYDB.OpenRecordset("report emails NEW")
myrec.Move First

Do Until myrec.EOF

WhereQ = myrec!whereto

Files = "C:\Users\XYZ" & myrec!reporttitle & " " & Year(Date) & 
     Format(Month(Date), "00") & Format(Day(Date), "00") & ".pdf"

If myrec!Files = -1 Then

Set qdf = db.QueryDefs("REPORT TEST")
qdf.SQL = "SELECT [Email Files].[Acct #], [Email Files].bs, [Email 
          Files].Filed, [Email Files].com, emailfiles([newpx]) AS npx, 
          IIf([Frac]='X','',[frac]) AS Expr1, comm([com]) AS comm, 
          sortmon([com]) AS [month], [Email Files].[2yr], * FROM [Email 
          Files] WHERE " & WhereQ & "; "  '"




If DCount("BS", "REPORT TEST") > 0 Then

    DoCmd.OutputTo acOutputReport, "REPORT TEST REPORT FILES", 
    acFormatPDF, Files


    With imsg

        .To = myrec!testemail
        .From = "sending email"
        .Subject = myrec!reporttitlefile & " for " & Format(Month(Date), 
                 "00") & "/" & Format(Day(Date), "00") & "/" & Year(Date)
        .HTMLBody = ""
        .AddAttachment (Files)

        Set .Configuration = iconf
        .Send

    End With

    Set iconf = Nothing
    Set imsg = Nothing
    Set flds = Nothing

    Else

    Set imsg = CreateObject("CDO.Message")
    Set iconf = CreateObject("CDO.Configuration")
    Set flds = iconf.Fields


    ' send one copy with SMTP server (with autentication)
    schema = "http://schemas.microsoft.com/cdo/configuration/"
    flds.Item(schema & "sendusing") = cdoSendUsingPort
    flds.Item(schema & "smtpserver") = "smtp.gmail.com"
    flds.Item(schema & "smtpserverport") = 25
    flds.Item(schema & "smtpauthenticate") = cdoBasic
    flds.Item(schema & "sendusername") = "email.com"
    flds.Item(schema & "sendpassword") = "abc"
    flds.Item(schema & "smtpusessl") = True
    flds.Update


    With imsg

        .To = myrec!testemail
        .From = "email.com"
        .Subject = myrec!Add & " has no files for " & Format(Month(Date), 
         "00") & "/" & Format(Day(Date), "00") & "/" & Year(Date)
        .HTMLBody = "Please let us know if you have a discrepancy."

        Set .Configuration = iconf
        .Send


    End With

    Set iconf = Nothing
    Set imsg = Nothing
    Set flds = Nothing
End If
Else
    'do nothing
End If
qdf.SQL = "SELECT [Email Files].[Acct #], [Email Files].bs, [Email 
Files].Filed, [Email Files].com, emailfiles([newpx]) AS npx, 
IIf([Frac]='X','',[frac]) AS Expr1, comm([com]) AS comm, sortmon([com]) 
AS [month], [Email Files].[2yr], * FROM [Email Files] "

myrec.MoveNext
Loop
End Function

Answer 1

我收到了您的问题，在这里您可以使用附带的 MS Access 数据库进行简单的解决方案，只需按照以下说明进行操作即可：

1- 创建一个名为 Module1 的新模块，然后声明这个全局变量，该变量在整个数据库级别（表单或报告）中进行，如下所示：

选项比较数据库

全局 GlbRepInfo 作为字符串

2- 将此代码放在将显示报告的原始表单中的推荐按钮中，如下所示：

私有子 CmdRepEmp_Click()

CmbEmp.SetFocus

GlbRepInfo = CmbEmp.Text

DoCmd.Close acReport, "RepSat", acSaveNo

DoCmd.OpenReport "RepEmp", acViewPreview, "EmpID=" & CmbEmp.Value

结束子

3- 最后，将此代码放入您的目标报告中，尤其是在加载事件中，如下所示：

Private Sub Report_Open(取消为整数)

LblRepInfo.Caption = "员工报告：" & vbNewLine & GlbRepInfo

结束子

数据库链接： enter link description here