我向每位客户发送一份报告,每天总结一天的情况。我不是为每个客户创建不同的报告,而是使用一个报告并更改用于提供报告的查询的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
发布于 2019-04-17 03:29:30
我知道你的问题了,这里是我的解决方案,附加了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-最后,将此代码放入您的目标报表中,特别是在load event上,如下所示:
私有子Report_Open(取消为整数)
LblRepInfo.Caption =“员工报告:”& vbNewLine & GlbRepInfo
结束子对象
数据库链接:enter link description here
https://stackoverflow.com/questions/55714311
复制相似问题