UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Help With Emailing And Pdf, Access 2016    
 
   
wornout
post May 10 2018, 08:16 PM
Post#1



Posts: 1,172
Joined: 17-November 13
From: Orewa New Zealand


I have had this code in my data base for 3 years now and all of a suden its stopped working.
In a folder QuestAkl → EmailReports I have a saved PDF called Newsletter
Then I open a record set and generate PDFs(invoice) from that.
Then it emails the invoice to the right email address some with 3 or more invoices to the one address all as separate PDFS it also picks up the news letter and sends to each address with the invoices

it was working and now it sends all invoices but the news letter only sends with the first Invoice or first email address and I have no idea why it suddenly changed.
It is almost like it kills/deletes the newsletter after the first email address so there is not one there to attache to the other ones

here is my code
code]Public Sub SaveRpt()


Dim db As Database
Dim qdfMyQuery As QueryDef
Dim rstCountOrders As Recordset
Dim PeriodMonth As String
Dim PeriodYear As String
Dim InvoiceNumber As String
Dim OwnerName As String
Dim objOutlook As Object 'Use for late binding
Dim MailOutLook As Object 'Use for late binding
Dim strPath As String
Dim strFileName As String
Dim strOwnerEmail As String
Dim strOwnerName As String
Dim strSubject As String
Dim strTxtBody As String
Dim ApartmentName As String
Dim strOwnerID As String



'*************************************************
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If objOutlook Is Nothing Then
Set objOutlook = CreateObject("Outlook.Application")
End If
'*****************************************************

Set MailOutLook = objOutlook.CreateItem(0) 'Late binding method


Set db = CurrentDb()

Set qdfMyQuery = db.QueryDefs("qryPropertyApartmentOwnerInvoiceDataOpt3E")


' Test for a value in the textbox
If Not IsNull([Forms]![frmSetPeriodInvoices]![cboMonth]) Then

' Set the value of the parameter.
PeriodMonth = [Forms]![frmSetPeriodInvoices]![cboMonth]
qdfMyQuery![[Forms]![frmSetPeriodInvoices]![cboMonth]] = PeriodMonth
PeriodYear = [Forms]![frmSetPeriodInvoices]![cboYear]
qdfMyQuery![[Forms]![frmSetPeriodInvoices]![cboYear]] = PeriodYear

' Create the recordset (or dynaset).
Set rstCountOrders = qdfMyQuery.OpenRecordSet()
If rstCountOrders.RecordCount = 0 Then
MsgBox "No records for " & PeriodMonth & PeriodYear

Else
'Set path to folder for PDF documents
strPath = "C:\QuestAkl\EmailReports"
With rstCountOrders
'set ownerID and owner emailaddress for first record
strOwnerID = !OwnerID
strOwnerEmail = !OwnerEmail
strSubject = "Quest Auckland " & " " & ![PeriodMonth] & " " & ![PeriodYear] & " " & "Invoice/s"
strTxtBody = "Please find attached your invoice/s for " & [PeriodMonth] & " " & [PeriodYear] _
& "for your information.<br /><br /><br /><br /><br />" _
& "<b>Warm Regards,<br /><br />Greg Cohen<br />" _
& "<b>Franchise Director,<br /><br />" _
& "Quest Auckland Apartment Hotel <br />" _
& "www.questauckland.co.nz,<br />363 Queen Street ,Auckland 1010 <br />" _
& "T: +64 9 300 2200 F: +64 9 300 2300 <br />" _
& "E: gm@ questauckland.co.nz"

While Not rstCountOrders.EOF
If Not strOwnerID = !OwnerID Then
'Send Saved documents
fAddFilesSend strPath, strOwnerEmail, strSubject, strTxtBody
'Reset ownername and owner emailaddress for next record
strOwnerID = !OwnerID
strOwnerEmail = !OwnerEmail
strTxtBody = "Please find attached your invoice/s for " & [PeriodMonth] & " " & [PeriodYear] _
& " for your information and also the latest newsletter for your reading<br /><br /><br /><br /><br />" _
& "<b>Warm Regards,<br /><br />Greg Cohen<br /><B>" _
& "Franchise Director,<br /><br />" _
& "Quest Auckland Apartment Hotel <br />" _
& "www.questauckland.co.nz,<br />363 Queen Street ,Auckland 1010 <br />" _
& "T: +64 9 300 2200 F: +64 9 300 2300 <br />" _
& "E: gm@ questauckland.co.nz"
End If

reportFilter = "tblInvoiceDataMaster.InvoiceNumber= " & !InvoiceNumber

strFileName = strPath & "\Quest Auckland_" & " " & "Invoice Number" & " " & !InvoiceNumber & ".pdf"

'Save report to PDF

DoCmd.OutputTo ObjectType:=acOutputReport, _
ObjectName:="rptInvoiceOpt3E", _
OutputFormat:=acFormatPDF, _
Outputfile:=strFileName

.MoveNext 'goto next record
Wend 'loop until last record reached

'Send saved documents for last owner in recordset
fAddFilesSend strPath, strOwnerEmail, strSubject, strTxtBody
'delete the newsletter <<<=== ADDED
Kill (gstrNewsletter) '<<<=== ADDED

'clear the public variable
reportFilter = ""
gstrNewsletter = "" '<<<===ADDED

End With
End If
End If
Forms!frmSetPeriodInvoices.Visible = False
exit_proc:
On Error Resume Next
rstCountOrders.Close
Set rstCountOrders = Nothing
Exit Sub

err_proc:
MsgBox Err.Description, vbExclamation
Resume exit_proc

End Sub

[/code]
Go to the top of the page
 
cheekybuddha
post May 10 2018, 09:17 PM
Post#2


UtterAccess VIP
Posts: 10,342
Joined: 6-December 03
From: Telegraph Hill


Hi,

If there's an error, you will never see it.

You turn off error reporting with 'On Error Resume Next', but never turn it on again!

After your Outlook code with all the asterisks add:
CODE
  On Error GoTo err_proc


It might help show up what's going wrong.

It would probably be prudent to add clean up code for your other object variables in exit_proc too:
db, qdfMyQuery, objOutlook, MailOutLook

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
wornout
post May 13 2018, 07:29 PM
Post#3



Posts: 1,172
Joined: 17-November 13
From: Orewa New Zealand


Ok I took out all on err code and it debugged and said file not found and highlighted Kill (gstrNewsletter) '<<<=== ADDED so I took it out
This is the code that sends the email somewhere it is not attaching the news letter to all the emails just the 1st one


CODE
Public Function fAddFilesSend(strPath As String, strToEMail As String, strSubject As String, strTxtBody As String)
On Error GoTo err_proc
'Function adds all ZIP files, from given folder location (strPath), to Outlook e-mail
'deletes the original file and displays e-mail

    Dim FS, F, f1, fc
    Dim objOutlook As Object    'Use for late binding
    Dim MailOutLook As Object   'Use for late binding
    
    
    '*************************************************
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
  
    If objOutlook Is Nothing Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
    '*****************************************************
    On Error GoTo exit_proc
    
    Set MailOutLook = objOutlook.CreateItem(0)
            With MailOutLook
                .BodyFormat = 3      'Late binding in lieu of olFormatRichText
                .To = strToEMail
                '.cc = ""
                '.bcc = ""
                .Subject = strSubject
                .HTMLBody = strTxtBody
                 'get files collection in strPath <<<
                Set FS = CreateObject("Scripting.FileSystemObject")
                Set F = FS.GetFolder(strPath)
                Set fc = F.Files
                'for each file in FIles <<<
                For Each f1 In fc
                    'we'll attach all PDF Files in strPath to the email
                    If Right(f1.Name, 3) = "pdf" Then
                      Debug.Print f1.Name, .Subject  '<<< commented out
                        .Attachments.Add (strPath & "\" & f1.Name)
                        'delete the file after attaching it, EXCEPT FOR THE NEWS LETTER
                        If Not f1.Name Like "NewsLetter " Then   '<<< added
                        'If InStr(1, f1.Name, "New Letter") > 0 Then '<<< alternate test
                             Kill (strPath & "\" & f1.Name)
                              Else  '<<<=== NEWLY ADDED
                            'save news letter path for later deletion <<=== NEWLY ADDED
                              gstrNewsletter = strPath & "\" & f1.Name  '<<=== NEWLY ADDED
                        End If   '<<< added
                        End If   '<<< added
                    
                    
                Next
    
                .Send
                '.Display  'Use for testing in lieu of .Send
            End With
    Forms!frmSetPeriodInvoices.Visible = False
exit_proc:
    Exit Function

err_proc:
    MsgBox Err.Description, , TempVars!strTitle
    Resume exit_proc
    
End Function
Go to the top of the page
 
wornout
post May 13 2018, 11:57 PM
Post#4



Posts: 1,172
Joined: 17-November 13
From: Orewa New Zealand


I think I have narrowed it down to this
CODE
If Not f1.Name Like "News Letter for" Then   '<<< added
                       ' If InStr(1, f1.Name, "Newsletter") > 0 Then '<<< alternate test
                             Kill (strPath & "\" & f1.Name)
                              Else  '<<<=== NEWLY ADDED
                             'save news letter path for later deletion <<=== NEWLY ADDED
                              'gstrNewsletter = strPath & "\" & f1.Name  '<<=== NEWLY ADDED
                        End If   '<<< added
                       ' End If   '<<< added


What it seems to be doing is deleting the news letter after the first email so its not adding it to the rest of them its like this part is not working "If Not f1.Name Like "Newsletterl" Then '<<< added"
Go to the top of the page
 
Phil_cattivocara...
post May 15 2018, 02:16 AM
Post#5



Posts: 199
Joined: 2-April 18



CODE
For Each f1 In fc
       If Right(f1.Name, 3) = "pdf" Then
           ...
           If Not f1.Name Like "NewsLetter " Then
                Kill (strPath & "\" & f1.Name)
           Else
                ...
           End If
       End If
   <div>Next
You are looping through every file in a folder and you want to execute some code only if it is a pdf file.
When you arrive to this line
CODE
If Not f1.Name Like "NewsLetter " Then
you are trying to do a thing like this
CODE
If Not ("yourfilename.pdf" Like "NewsLetter ") Then
and
CODE
"yourfilename.pdf" Like "NewsLetter "
is always false, even if it is "NewsLetter.pdf". With Not before you will always execute the True part of If ... Then ... ElseOr you make a perfect comparison or you use a wildcard
CODE
f1.Name Like "NewsLetter*"

--------------------
Please forgive in advance my horrible English.
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    22nd September 2018 - 03:43 PM