Solved MVFs with file Attachments and Outlook.attachment = .attachments.add() (1 Viewer)

Gregory Long

New member
Local time
Today, 12:51
Joined
Feb 23, 2022
Messages
9
Hi Everyone. I am in need of help from someone that is way smarter than me. I created a simple database to keep track of personnel and their assigned tasks. I have an attachment MVF field in this database. I know they aren't recommended but it keeps everything in one place. Most of the attachments are 1 page PDFs. This database automatically sends a generic text email to the person when a task is assigned to them so they know to go and open the database and look at the request. I have now been asked if I can send any attachments that have been placed in the MVF attachment field of the record with the generic text email. Can this be done?

I have successfully sent myself an attachment from the database but the file was located in the same directory as the database so I just reference the filepath anf filename. How can one reference and select the items that are in the MVF field and send them instead.

Thanks in advance for everyone's help.

Greg
 

bastanu

AWF VIP
Local time
Today, 09:51
Joined
Apr 13, 2010
Messages
1,401
You will probably need to loop through your attachments, download them locally (in the same folder as the front-end), attach them to the email message then finally delete them with Kill fileneme.
 

Ranman256

Well-known member
Local time
Today, 12:51
Joined
Apr 9, 2015
Messages
4,339
open the table as a recordset, then
cycle thru the recordset to get each record which itself is a recordset,
then extract each item to a target folder
then
cycle thru all files in the folder to add to the .Attachement
 

Gregory Long

New member
Local time
Today, 12:51
Joined
Feb 23, 2022
Messages
9
OK. So using the examples that Bastanu and theDBguy provided I created a parent and a child recordset. The parent recordset is for the table RCSE and the child recordset is for the MVF column that is named attachments. I am so close to getting this to work but I keep having trouble going back to my current table record while in the child recordset. I have added msg boxes into the code in places so I can see my location as I step through the code but as soon as I go into the child recordset it goes to the last record in the RCSE table. Does anyone know how to pass the current location of the parent recordset to correlate to the child recordset. I know it's possible, I just can't remember how. It's only been 26 years since I had VBA class.

Thanks for your help,
Greg

Code:
Option Compare Database

Public Function GLL(strPath As String, Optional strPattern As String = "*.*") As Long
        
  Dim dbs As Database
  Dim rst As DAO.Recordset 'parent recordset
  Dim rsa As DAO.Recordset 'child recordset
  Dim CurrentPosition As String
  Dim strFullPath As String
      
  Set dbs = CurrentDb 'set current database
  Set rst = dbs.OpenRecordset("RCSE") 'open parent recordset
 
  With rst
     CurrentPosition = Forms("RCSE").Recordset.ID
      If MsgBox(CurrentPosition & " beginning", vbOKCancel) = vbCancel Then End
      .MoveFirst 'used to fully populate recordset
      .MoveLast 'used to fully populate recordset
      DoCmd.GoToRecord acDataForm, "RCSE", acGoTo, CurrentPosition
      If MsgBox(CurrentPosition & " after DoCmd", vbOKCancel) = vbCancel Then End
 
 Set rsa = rst("Attachments").Value 'open child (MVF) recordset

 Do While Not rsa.EOF
    If rsa("FileName") Like strPattern Then
    strFullPath = strPath & "\" & rst("ID").Value & " - " & rsa("FileName")

 If MsgBox(rst("ID") & " RSA ID", vbOKCancel) = vbCancel Then End
 
 If MsgBox(CurrentPosition & " Before File Download", vbOKCancel) = vbCancel Then End
 
    rsa("FileData").SaveToFile strFullPath
    
 If MsgBox(CurrentPosition & " After File Download", vbOKCancel) = vbCancel Then End
    
 If Dir(strFullPath) = "" Then
 End If
            
 'Increment the number of files saved
 GLL = GLL + 1
 End If
    
 'Next Attachment
  rsa.MoveNext
 
 Loop
    rsa.Close
    rst.Close
    dbs.Close
    
    Set rsa = Nothing
    Set rst = Nothing
    Set dbs = Nothing

  End With
  
End Function
 

theDBguy

I’m here to help
Staff member
Local time
Today, 09:51
Joined
Oct 29, 2018
Messages
21,358
Just a quick scan, but you did use MoveLast, so maybe add a MoveFirst afterwards? Just a thought...
 

bastanu

AWF VIP
Local time
Today, 09:51
Joined
Apr 13, 2010
Messages
1,401
Hi Greg,

You are overcomplicating things, when navigating through recordsets you don't want or need to navigate through the form as well. Would you please post your existing code to send the emails? It should be in there as you create each message where you add the code to download any attachments, add them to current message (attachments.add), send it, delete the files and move next.

Cheers,
 

Gasman

Enthusiastic Amateur
Local time
Today, 16:51
Joined
Sep 21, 2011
Messages
14,044
PMFJI,
No need for code below I would have thought, unless you want the recordcount up front?
Just walk the recordset until EOF?

Code:
      .MoveFirst 'used to fully populate recordset
      .MoveLast 'used to fully populate recordset
 

Gregory Long

New member
Local time
Today, 12:51
Joined
Feb 23, 2022
Messages
9
Hi Vlad,

Here is the code that I have to send emails. It sends the email when a task is given an assigned date. I had to remove the actual email addresses for security reasons. The emails come from a multi-column combo box along with the users name. I was able to successfully attach an attachment but I had to tell it the name and path of the file. Thanks again for your help.

Code:
Option Compare Database

Private Sub Assigned_Date_AfterUpdate()

'check to make sure that the email address or the assigned date is null, if so it will end
If Len(Me.EmailAddress & vbNullString) = 0 Or Len(Me.Assigned_Date & vbNullString) = 0 Then
 
  End

Else 'send email to the person assigned when the assigned date is populated

   Dim objOutlook As outlook.Application
   Dim objOutlookMsg As outlook.MailItem
   Dim objOutlookRecip As outlook.Recipient
   Dim objOutlookAttach As outlook.Attachment
   Dim otest As outlook.SenderInAddressListRuleCondition
  
   ' Create the Outlook session.
   Set objOutlook = CreateObject("Outlook.Application")

   ' Create the message.
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

   With objOutlookMsg
  
      'Add Sender 
      objOutlookMsg.SentOnBehalfOfName = "email goes here"
  
      ' Add the To recipient(s) to the message.

            Set objOutlookRecip = .Recipients.Add(Me.EmailAddress)
           'Set objOutlookRecip = .Recipients.Add("email goes here")
            objOutlookRecip.Type = olTo

      ' Add the CC recipient(s) to the message.
            Set objOutlookRecip = .Recipients.Add("email goes here")
            objOutlookRecip.Type = olCC

      ' Set the Subject, Body, and Importance of the message.
          .Subject = Me.CSE_Assigned & " has been assigned a new task."
          .Body = Me.CSE_Assigned & " has been assigned " & Me.Task_Description & " in the RCSE Database. This task has a requested due date of " & Me.Requested_Due_Date & ". Please refer to the RCSE database for more information." & vbCrLf & vbCrLf & _
              "***This is an RCSE Database Automated Message. Please do not respond to this email as the mailbox is not monitored.***" & vbCrLf & vbCrLf & _
              "Please address any questions to email goes here." & vbCrLf & vbCrLf
          .Importance = olImportanceHigh  'High importance

 '     Add attachments to the message.
 '     If Not IsMissing(AttachmentPath) Then
 '        Set objOutlookAttach = .Attachments.Add(AttachmentPath)
 '     End If

      ' Resolve each Recipient's name.
      For Each objOutlookRecip In .Recipients
         objOutlookRecip.Resolve
         If Not objOutlookRecip.Resolve Then
         objOutlookMsg.Display
      End If
    
      Next
      .Send

   End With
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing

End If

End Sub

Private Sub CSE_Assigned_AfterUpdate()
  'Assigns value to EmailAddress from the multicolumn combo box CSE_Assigned
  Me.EmailAddress = Me![CSE_Assigned].Column(1)

End Sub
 

bastanu

AWF VIP
Local time
Today, 09:51
Joined
Apr 13, 2010
Messages
1,401
Hi Greg,
Please give this a try, go through the code first and read the comments to make sure everything seems correct:
Code:
Option Compare Database

Private Sub Assigned_Date_AfterUpdate()

'check to make sure that the email address or the assigned date is null, if so it will end
If Len(Me.EmailAddress & vbNullString) = 0 Or Len(Me.Assigned_Date & vbNullString) = 0 Then
  End
Else 'send email to the person assigned when the assigned date is populated

   Dim objOutlook As outlook.Application
   Dim objOutlookMsg As outlook.MailItem
   Dim objOutlookRecip As outlook.Recipient
   Dim objOutlookAttach As outlook.Attachment
   Dim otest As outlook.SenderInAddressListRuleCondition
 
   ' Create the Outlook session.
   Set objOutlook = CreateObject("Outlook.Application")

   ' Create the message.
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

   With objOutlookMsg
 
      'Add Sender
      objOutlookMsg.SentOnBehalfOfName = "email goes here"
 
      ' Add the To recipient(s) to the message.

            Set objOutlookRecip = .Recipients.Add(Me.EmailAddress)
           'Set objOutlookRecip = .Recipients.Add("email goes here")
            objOutlookRecip.Type = olTo

      ' Add the CC recipient(s) to the message.
            Set objOutlookRecip = .Recipients.Add("email goes here")
            objOutlookRecip.Type = olCC

      ' Set the Subject, Body, and Importance of the message.
          .Subject = Me.CSE_Assigned & " has been assigned a new task."
          .Body = Me.CSE_Assigned & " has been assigned " & Me.Task_Description & " in the RCSE Database. This task has a requested due date of " & Me.Requested_Due_Date & ". Please refer to the RCSE database for more information." & vbCrLf & vbCrLf & _
              "***This is an RCSE Database Automated Message. Please do not respond to this email as the mailbox is not monitored.***" & vbCrLf & vbCrLf & _
              "Please address any questions to email goes here." & vbCrLf & vbCrLf
          .Importance = olImportanceHigh  'High importance

 '     Add attachments to the message.
'Vlad - we need to save attachments to file first:
Dim dbs As Database
Dim rst As DAO.Recordset 'parent recordset
Dim rsa As DAO.Recordset 'child recordset
Dim sFile as String 
 
Set dbs = CurrentDb 'set current database
Set rst = dbs.OpenRecordset("SELECT * FROM [RCSE] WHERE [ID] = " & Me.CSE_Assigned) 'open parent recordset 'Vlad - assume the ID is the PK of the                                     'table holding contact info and the CSE_Assigned combo is bound to that

 
   ' Instantiate the child recordset.
   Set rsa = rst.Fields("Attachments").Value 
 
   '  Loop through the attachments.
   While Not rsa.EOF 
    sFile =CurrentProject.Path & "\" & rsa.Fields("FileName")
      '  Save current attachment to disk in the front-end folder.
      rsa.Fields("FileData").SaveToFile  sFile
      Set objOutlookAttach = .Attachments.Add(sFile) 'attach file to message
      Kill sFile 'delete file
      rsa.MoveNext
   Wend

 '     If Not IsMissing(AttachmentPath) Then
 '        Set objOutlookAttach = .Attachments.Add(AttachmentPath)
 '     End If

      ' Resolve each Recipient's name.
      For Each objOutlookRecip In .Recipients
         objOutlookRecip.Resolve
         If Not objOutlookRecip.Resolve Then
         objOutlookMsg.Display
      End If
    
      Next
      .Send

   End With
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
   Set rst=Nothing
   Set rsa = Nothing
End If

End Sub

Private Sub CSE_Assigned_AfterUpdate()
  'Assigns value to EmailAddress from the multicolumn combo box CSE_Assigned
  Me.EmailAddress = Me![CSE_Assigned].Column(1)

End Sub
 

Gregory Long

New member
Local time
Today, 12:51
Joined
Feb 23, 2022
Messages
9
I was able to download only the attachments for a specific record instead of all the records. I used this code. I think once I add all this together that it just might work. Thanks for all the help.

Code:
Public Function GLL(strPath As String, Optional strPattern As String = "*.*") As Long
        
  Dim dbs As Database
  Dim rst As DAO.Recordset 'parent recordset
  Dim rsa As DAO.Recordset 'child recordset
  Dim CurrentPosition As Integer
  Dim strFullPath As String
      
  Set dbs = CurrentDb 'set current database
  Set rst = dbs.OpenRecordset("RCSE") 'open parent recordset
 
  CurrentPosition = Forms("RCSE").Recordset.ID 'find current record position
  rst.FindFirst "[ID] = " & CurrentPosition   'go to the current record
 
  With rst
      
     Set rsa = rst("Attachments").Value 'open child (MVF) recordset

    Do While Not rsa.EOF
     If rsa("FileName") Like strPattern Then
            strFullPath = strPath & "\" & rst("ID").Value & " - " & rsa("FileName")
            rsa("FileData").SaveToFile strFullPath
       If Dir(strFullPath) = "" Then
       End If
           GLL = GLL + 1 'Increment the number of files saved
     End If
           rsa.MoveNext  'GoTo Next Attachment
    Loop
           rsa.Close
           rst.Close
           dbs.Close
    
           Set rsa = Nothing
           Set rst = Nothing
           Set dbs = Nothing

  End With
  
End Function
 

bastanu

AWF VIP
Local time
Today, 09:51
Joined
Apr 13, 2010
Messages
1,401
But why download them all at once when you only send the email to selected one in the combo? If you would have a button to send all emails in a loop I would understand wanting to have them all at hand, but not when your code is in the AfterUpdate event of a control bound to one specific record.

Cheers,
 

Gasman

Enthusiastic Amateur
Local time
Today, 16:51
Joined
Sep 21, 2011
Messages
14,044
Could likely remove this ?
Code:
       If Dir(strFullPath) = "" Then
       End If
 

Gregory Long

New member
Local time
Today, 12:51
Joined
Feb 23, 2022
Messages
9
Oh, I'm so close. I'm getting a run-time error 3075: Syntax error (comma) in query expression '[ID] = Long, Gregory'.
from the following line of code. I think this is caused from where the field CSE_Assigned contains record date in the format Lastname, Firstname
Note that I changed the reference Me!CSE_Assigned to the full reference Forms![RCSE]!CSE_Assigned to see if that would fix it but it didn't help. Anyone have any suggestions?

Code:
Set rst = dbs.OpenRecordset("SELECT * FROM [RCSE] WHERE [ID] = " & Forms![RCSE]!CSE_Assigned)
 

theDBguy

I’m here to help
Staff member
Local time
Today, 09:51
Joined
Oct 29, 2018
Messages
21,358
Oh, I'm so close. I'm getting a run-time error 3075: Syntax error (comma) in query expression '[ID] = Long, Gregory'.
from the following line of code. I think this is caused from where the field CSE_Assigned contains record date in the format Lastname, Firstname
Note that I changed the reference Me!CSE_Assigned to the full reference Forms![RCSE]!CSE_Assigned to see if that would fix it but it didn't help. Anyone have any suggestions?

Code:
Set rst = dbs.OpenRecordset("SELECT * FROM [RCSE] WHERE [ID] = " & Forms![RCSE]!CSE_Assigned)
I would expect a value for a field called "ID" to be numeric. If it is, then the question would be: "Why are you comparing the ID to a Text value (Long, Gregory)?"
 

bastanu

AWF VIP
Local time
Today, 09:51
Joined
Apr 13, 2010
Messages
1,401
What are you storing in the CSE_Assigned field in RCSE table? I would have expected to be the ID, not the Last,First. Unless....you are using a Lookup field in the table design. You should not use those, see here for more info:http://access.mvps.org/access/lookupfields.htm

Cheers,
 

Gregory Long

New member
Local time
Today, 12:51
Joined
Feb 23, 2022
Messages
9
The ID field is an autonumber field and it is the primary key. The CSE_Assigned field is where the users name is stored in the Lastname, Firstname format.
 

bastanu

AWF VIP
Local time
Today, 09:51
Joined
Apr 13, 2010
Messages
1,401
But why :)? Is it to late to change it now? The combo should have its row source set to SELECT ID,[LastName] & ", " & [FirstName] As FullName FROM RCSE Order By LastName,FirstName;"; you keep the first column bound , set column number to 2 and Column Width to 0";3". So now the combo will still display the LastName, FirstName but it will be (properly :)) bound to the ID.
If it is too late to change you can try to identify the record by the email instead of the PK (ID):

Set rst = dbs.OpenRecordset("SELECT * FROM [RCSE] WHERE [EmailAddress] = " & Me![CSE_Assigned].Column(1))
 

Gregory Long

New member
Local time
Today, 12:51
Joined
Feb 23, 2022
Messages
9
OK. After several iterations I have finally got code that actually works as intended. I would like to thank everyone for their help because I would not have been able to solve this without them. Below is the final version of the code.

Code:
Private Sub SendEmailWithAttach_Click()

 ' check to make sure that the email address or the assigned date is null, if so it will end
  If Len(Me.EmailAddress & vbNullString) = 0 Or Len(Me.Assigned_Date & vbNullString) = 0 Then
  End

  Else 'send email to the person assigned when the assigned date is populated

  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookRecip As Outlook.Recipient
  Dim objOutlookAttach As Outlook.Attachment
  Dim otest As Outlook.SenderInAddressListRuleCondition
  
' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
  Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

  With objOutlookMsg
  
' Add Sender Email
  objOutlookMsg.SentOnBehalfOfName = "sender email goes here"
  
' Add the To recipient(s) to the message.

  Set objOutlookRecip = .Recipients.Add(Me.EmailAddress)
  objOutlookRecip.Type = olTo

' Add the CC recipient(s) to the message.
  Set objOutlookRecip = .Recipients.Add("cc recipient email goes here")
  objOutlookRecip.Type = olCC

' Set the Subject, Body, and Importance of the message.
  .Subject = Me.CSE_Assigned & " has been assigned a new task."
  .Body = Me.CSE_Assigned & " has been assigned " & Me.Task_Description & " in the RCSE Database. This task has a requested due date of " & Me.Requested_Due_Date & ". Please refer to the RCSE database for more information." & vbCrLf & vbCrLf & _
  "***This is an RCSE Database Automated Message. Please do not respond to this email as the mailbox is not monitored.***" & vbCrLf & vbCrLf & _
  "Please address any questions to (add contact email here)." & vbCrLf & vbCrLf
  .Importance = olImportanceHigh  'High importance

' Add attachments to the message.
' -------------------------------------------

  Dim dbs As Database
  Dim rst As DAO.Recordset2 'parent recordset
  Dim rsa As DAO.Recordset2 'child recordset
  Dim CurrentPosition As Integer
  Dim sFile As String
      
  Set dbs = CurrentDb 'set current database
  Set rst = dbs.OpenRecordset("RCSE") 'open parent recordset
 
  CurrentPosition = Forms("RCSE").Recordset.ID 'find current record position
  rst.FindFirst "[ID] = " & CurrentPosition   'go to the current record

  Set rsa = rst("Attachments").Value 'Instantiate child (MVF) recordset

  While Not rsa.EOF
  'If rsa("FileName") Like strPattern Then
  sFile = CurrentProject.path & "\" & rst.Fields("ID").Value & " - " & rsa.Fields("FileName")
  rsa.Fields("FileData").SaveToFile sFile
  If Not IsMissing(sFile) Then
  Set objOutlookAttach = .Attachments.Add(sFile) 'attach file to message
  End If
  Kill sFile
  rsa.MoveNext
  Wend

  rsa.Close
  rst.Close
  dbs.Close
    
  Set rsa = Nothing
  Set rst = Nothing
  Set dbs = Nothing

' Resolve each Recipient's name.
  For Each objOutlookRecip In .Recipients
  objOutlookRecip.Resolve
  If Not objOutlookRecip.Resolve Then
  objOutlookMsg.Display
  End If
    
  Next
  .Send

  End With
  Set objOutlookMsg = Nothing
  Set objOutlook = Nothing

  End If

End Sub
 

Users who are viewing this thread

Top Bottom