Add Attachement with Loop

[Gerrit.B]

Is use code below to create mail and add "default" attachments.

Public Function mailPDFReport2()

Dim MyOutlook As New Outlook.Application
Dim Item As Outlook.MailItem
Dim sReport As String
Dim namePath As String
Dim FileName As String
Dim rpt As Access.Report


Subjectline$ = InputBox$("Please enter the subject line for this mailing.", "We Need A Subject Line!")
sPath = Application.CurrentProject.Path & "\"
sReport = "rptOffer2"
FileName = "Offer.pdf"


namePath = sPath & FileName
DoCmd.OutputTo objecttype:=acOutputReport, objectname:=sReport, outputformat:=acFormatPDF, outputfile:=namePath, autostart:=False
Set Item = MyOutlook.CreateItem(mItem)
With Item
Item.To = ""


Item.Subject = Subjectline$
Item.Body = BodyFile$
Item.Attachments.Add namePath
Item.Attachments.Add "\\SERVER01\Dokumenten\DB\BE\General Terms Of Sale.pdf"
Item.Display
End With
End Function

Now I want to add attachments with loop. Depending of availability.
For that I created query to check if pdf file excists.

strSql = "SELECT QryOfferExtended.ProductSpecFile " & vbCrLf & _     "FROM QryOfferExtended " & vbCrLf & _
     "WHERE (((QryOfferExtended.ProductSpecFile) Is Not Null And (QryOfferExtended.ProductSpecFile)<>""""));"

How can I change my code to add a loop to add additional attachments?

 

[Micron]

Too many quotes in the sql and un-needed characters & I think one too many ' ( ' or not enough ' ) '. Change to something like this if you can't fit text on one line:
strSql = "SELECT QryOfferExtended.ProductSpecFile FROM QryOfferExtended WHERE "
strSql = strSql & "(((QryOfferExtended.ProductSpecFile) Is Not Null) And "
strSql = strSql & "(QryOfferExtended.ProductSpecFile)<>''));" 'note 2 SINGLE quotes
create a recordset object, set it and loop through it. You will have to figure out where to put these elements, but this should be close:

Dim rs as DAO.recordset 'these go at top with the other Dim statements
Dim db as DAO.database 'I'm assuming you have the project references for DAO

set  db = currentdb 'create this before the email part, I think
set rs = db.execute strSql, dbfailonerror 'hope I have that right for running a select statement

'put this part after the item.body line
do while not rs.EOF[INDENT]rs.movefirst
namepath="" 'probably not necessary to prevent continuously adding to this in loop, but doesn't hurt.
'looks like your query will only return 1 field so either use the field name or zero based index #
namepath = "\\SERVER01\Dokumenten\DB\BE\" & rs.fields(0)
item.add namepath
rs.movenext
[/INDENT]
loop
'carry on with rest of code

 

[Gerrit.B]

Problem Solved.
Changed select query to MakeTable query and changed strSql = "tblAttachment".
Code below is working now.

Thanks for te HELP.

Option Compare Database

Const sDefaultPath As String = "C:\Temp\"




Public Function OfferAndSpecs()
Dim MyOutlook As New Outlook.Application
Dim Item As Outlook.MailItem
Dim sReport As String
Dim namePath As String
Dim FileName As String
Dim rpt As Access.Report
Dim rs As DAO.Recordset 'these go at top with the other Dim statements
Dim db As DAO.Database 'I'm assuming you have the project references for DAO
Dim strSql As String


DoCmd.SetWarnings False
DoCmd.OpenQuery "MT_tblAttachments"
DoCmd.SetWarnings True
         
strSql = "tblAttachment"


         
Set db = CurrentDb  'create this before the email part, I think
Set rs = db.OpenRecordset(strSql) '  dbfailonerror 'hope I have that right for running a select statement


Subjectline$ = InputBox$("Please enter the subject line for this mailing.", "We Need A Subject Line!")
sPath = Application.CurrentProject.Path & "\"
sReport = "rptOffer"
FileName = "Offer.pdf"


namePath = sPath & FileName
DoCmd.OutputTo objecttype:=acOutputReport, objectname:=sReport, outputformat:=acFormatPDF, outputfile:=namePath, autostart:=False
Set Item = MyOutlook.CreateItem(mItem)
With Item
Item.To = ""


Item.Subject = Subjectline$
Item.Body = BodyFile$
Item.Attachments.Add namePath
Item.Attachments.Add "\\SERVER01\Dokumenten\DB\BE\General Terms Of Sale.pdf"




If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True
    
namePath = ""   'probably not necessary to prevent continuously adding to this in loop, but doesn't hurt.
                'looks like your query will only return 1 field so either use the field name or zero based index #
namePath = sDefaultPath & rs.Fields(0)
'Item.Add namePath


Item.Attachments.Add namePath


rs.MoveNext


Loop
Else




End If
Item.Display
End With
End Function

 

[Micron]

Glad I could help. Not sure of a couple of things, though.

*If Not (rs.EOF And rs.BOF): If you're trying to check if you're not at the beginning nor the end of file, this is not correct. You're saying "if not at bof and rs.bof" which when you really think about it, makes no sense. I think you want
If Not (rs.EOF) AND if not (rs.BOF). Or is it OR, because I don't quite get your intent. What if it is the beginning or end ( possible that it could start anywhere)? Nothing will happen. What I wrote is quite commonly used (moving to the first record then "Do while not rs.EOF"
*You do not need the Else if you are doing nothing with it.
*Keep in mind that since there is no error trapping here, error handling will direct execution back to the nearest higher order where you have it. There is lots of potential for errors with these types of events.
Good Luck!