Как заполнить несвязанный текст в отчете из таблицы? - PullRequest
Новая
       30

Как заполнить несвязанный текст в отчете из таблицы?

0 голосов
/ 16 апреля 2019

Я отправляю отчет каждому клиенту ежедневное резюме со дня.Вместо того, чтобы создавать разные отчеты для каждого клиента, я использую один отчет и меняю оператор 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

1 Ответ

0 голосов
/ 16 апреля 2019

Я получил ваш вопрос, и вот вам мое скромное решение с приложенной базой данных MS Access, просто выполните следующие инструкции:

1- Создайте новый модуль с именем Module1, затем объявите эту глобальную переменную, которая входит и попадает на весь уровень базы данных, либо в формы, либо в отчеты, как это:

Опция сравнения базы данных

Global GlbRepInfo As String

2- Поместите этот код в кнопку commend из оригинальной формы, в которой будет отображаться отчет, например:

Private Sub CmdRepEmp_Click ()

CmbEmp.SetFocus

GlbRepInfo = CmbEmp.Text

DoCmd. Закрыть acReport, "RepSat", acSaveNo

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

End Sub

3- И наконец, поместите этот код в целевой отчет, особенно при загрузке, например:

Private Sub Report_Open (Отменить как целое число)

LblRepInfo.Caption = "Отчет сотрудников:" & vbNewLine & GlbRepInfo

End Sub

Линк БД: введите описание ссылки здесь

enter image description here

...