how to add attachments to email using subform field to for attachtment path

sspreyer

Registered User.
Local time
Yesterday, 16:43
Joined
Nov 18, 2013
Messages
251
how to add attachments to email using a subform field for the attachtment paths

hi ,all

I m wondering how to add attachments to a email using a sub form were I store the attachment paths

e.g I have a main form called frmteaminfomer with various fields and continuous subform called attachmentssubform in the sub form I have a field call txtaddress . I have some code that I can pick a file then put its file path into txtaddress field and also have a check box call add to email. so what I trying to do is loop through all the records in the subform and if the check box is true add the files as attachment on the email

I have search google to deaf and haven't manage to source any code

my vba knowledge is very little
any help much appreciated
thanks in advance

shane
 
Last edited:
Begin with adding an attachment by hard coding the path to the document. Then you can proceed to looping through the recordset to pick it up automatically:

http://www.rondebruin.nl/win/s1/outlook/amail1.htm


hi , vbaInet

this what I have so far my understanding is rschild is the sub form with this code below I get a runtime error 91 object variable block

Code:
Private Sub sendtest_Click()

     
   
 Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim OutlookAttach As Outlook.Attachment
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

  
        Set appOutLook = New Outlook.Application
        Set ns = appOutLook.GetNamespace("MAPI")
        Dim folderOutlook As Folder
        Set folderOutlook = ns.GetDefaultFolder(olFolderInbox)
        folderOutlook.Display
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
 Dim strHTML
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.OpenRecordset
 ' strHTML = strHTML & "<FONT Face=Calibri><b>ID: </b></br>" & [ID] & "<br>"
 'strHTML = strHTML & "<FONT Face=Calibri><b>Date: </b></br>" & [Date 1] & "<br>"
 'strHTML = strHTML & "<FONT Face=Calibri><b>Address: </b></br>" & [Address] & "<br>" & "<br>"
 'strHTML = strHTML & "<FONT Face=Calibri><b>Works Description: </b></br>" & [Works Description] & "<br>"
 'strHTML = strHTML & "<FONT Face=Calibri><b>Notes: </b></br>" & [Notes] & "<br>"
 'strHTML = strHTML & "<FONT Face=Calibri><b>Comments.: </b></br>" & [Comments1] & "<br><br>"
 'strHTML = strHTML & "<FONT Face=Calibri><b>Notifiable: </b></br>" & [Notifiable] & "<br>"
 'strHTML = strHTML & "</FONT></br><BODY>"
'strHTML = strHTML & "<FONT Face=Arial Color=#ff0000 Size=5>Job #: 123456</FONT></br>"
'strHTML = strHTML & "<FONT Size=3>For: <FONT Size=2></B>a name here</br>"
'strHTML = strHTML & "<FONT Size=3><B>Description: </B><FONT Size=2>description of work to be done</FONT></br>"
 strHTML = strHTML & "</BODY></HTML>"
'On Error Resume Next
myDir = "C:\Users\Dell\Documents\TEST\"
MYFILE1 = "lastleasedue60.pdf"
DoCmd.OutputTo acReport, "lastleasedue60", acFormatPDF, myDir & MYFILE1
 With MailOutLook
[COLOR=red][B]If Not IsNull(rsChild.txtAddress) Then
With MailOutLook
.Attachments.Add (rsChild.txtAddress) ' 'filename' ' or whatever the actual[/B][/COLOR] code is
 end if
 With MailOutLook
.Attachments.Add myDir & MYFILE1

 End With
 


 
 Kill myDir & MYFILE1
  
 .BodyFormat = olFormatRichText
'.To = "email address"
'.CC = " "
.Body = "Some text here"
.Subject = ""
 .HTMLBody = strHTML
 .Display
'Send email
'.DeleteAfterSubmit = True 'This would let Outlook send the note without storing it in your sent bin
'.Send
On Error Resume Next
     On Error GoTo 0
 End With
 
 End Sub
 
You're probably getting ahead of yourself. I mentioned that you should first hard code the file path as can be seen in the link, get that working before you consider grabbing it from the recordset.

Did you manage to get the hard coded part working at the first stage?
 
Did you manage to get the hard coded part working at the first stage?

yeah the first bit works perfectly I think you jumped on the thread to quick before I edited it lol.I updated the code as saw an error and I can get it to work on the main form issue I am having is getting it to work with the sub form ok I ll make the code your requesting

thanks for the help

shane
 
here's a hardcoded version
Code:
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2013
'This example send the last saved version of the Activeworkbook
'For Tips see: [URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL]
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.to = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "code from vbaInet link"
.Body = "Hi there"
.Attachments.Add (C:\Users\Dell\Documents\TEST\Void Liecensed.pdf)

.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub
now the path is hardcoded
cheers

shane
 
You need to type quicker ;)

For the second part you need to loop through each record in the subform. Here's some aircode to get you started:
Code:
    Dim rst As DAO.Recordset
    
    With Me.SubformName
        If .Dirty Then .Dirty = False
        Set rst = .RecordsetClone
    End With
    
    With rst
        Do While Not .EOF
            MsgBox !PathField
            .MoveNext
        Loop
    End With
    
    Set rst = Nothing
Get this part working then you can look into combining both pieces.
 
Yes, looks good Shane.

NB: Please remember code tags ;)
 
right...............

this works but I only want it to loop the records in the subform that are link to the main form as at the moment its looping the whole table that is link to the subform
Code:
Dim olApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment
 Set outApp = New Outlook.Application
Set outMail = olApp.CreateItem(olMailItem)
 With outMail
    .BodyFormat = olFormatHTML
    .To = "" ' Left
    .CC = ""
    .Subject = "test for VbaInet"
    .Body = "VbaInet Help Me "
     'Add Attachments
    Dim db As DAO.Database
    
    Dim rstAttachments As DAO.Recordset
        
    Set db = CurrentDb()
    Set rstAttachments = db.OpenRecordset("Select txtaddress from attachments")
    
    If rstAttachments.RecordCount > 0 Then
        With rstAttachments
            Do Until .EOF
         oulMail.Attachments.Add (rstAttachments!txtaddress)
                
                .MoveNext
            Loop
        End With
    End If
     .Save
    .Display
End With
Set outMail = Nothing
Set objOutlookAttach = Nothing
Set outApp = Nothing
Set rstAttachments = Nothing
Set db = Nothing
 
End Sub

thanks

shane
 
I'm going to head off to bed I report back tomorrow how I get on :)
 
I' m back .....

I have had ago with the link you provided vbaInet but still isn't working the error message I get is run error 91 variable not set just some more notes the main form id is call teamid and the subform id that is link to the main form id is linkattachments I have highlight the error line

to be honest I'm well lost and confused :banghead:

here the code so far

Code:
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment
Dim rstFiltered As DAO.Recordset
Dim strteamid As String
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
Dim rst As DAO.Recordset
With olMail
    .BodyFormat = olFormatHTML
    .To = "" ' Left
    .CC = ""
    .Subject = "test for VbaInet"
    .Body = "VbaInet Help Me "
     'Add Attachments
    Dim db As DAO.Database
    
    Dim rstAttachments As DAO.Recordset
        
    Set db = CurrentDb()
    
      Set rstAttachments = db.OpenRecordset("SELECT * FROM tblteaminformer INNER JOIN attachments ON tblteaminformer.TeamID = attachments.linkattatchment")
    
   [COLOR=red][B]strteamid = rst!TeamID
[/B][/COLOR]  rst.Filter = "teamid = '" & strteamid & "'"
    Set rstFiltered = rst.OpenRecordset
    
    
    If rstAttachments.RecordCount > 0 Then
        With rstAttachments
            Do Until .EOF
         olMail.Attachments.Add (rstAttachments!txtaddress)
                
                .MoveNext
            Loop
        End With
    End If
     .Save
    .Display
End With
Set olMail = Nothing
Set objOutlookAttach = Nothing
Set olApp = Nothing
Set rstAttachments = Nothing
Set db = Nothing
 'MsgBox "Mail Sent!", vbOKOnly, "Mail Sent
 
Look carefully at your code, rst and rstAttachments.

does this look any better I'm getting different message error message now runtime error 3464 data type mismatch :banghead:

Code:
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment
Dim rstFiltered As DAO.Recordset
Dim strteamid As String
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
Dim rst As DAO.Recordset
With olMail
    .BodyFormat = olFormatHTML
    .To = "" ' Left
    .CC = ""
    .Subject = "test for VbaInet"
    .Body = "VbaInet Help Me "
     'Add Attachments
    Dim db As DAO.Database
    
        
    Set db = CurrentDb()
          Set rst = db.OpenRecordset("SELECT * FROM tblteaminformer INNER JOIN attachments ON tblteaminformer.TeamID = attachments.linkattatchment")
    
    strteamid = rst!TeamID
    rst.Filter = "teamid = '" & strteamid & "'"
 [COLOR=red][B]   Set rst = rst.OpenRecordset
[/B][/COLOR]   
    
    If rst.RecordCount > 0 Then
        With rst
            Do Until .EOF
         olMail.Attachments.Add (rst!txtaddress)
                
                .MoveNext
            Loop
        End With
    End If
     .Save
    .Display
End With
Set olMail = Nothing
Set objOutlookAttach = Nothing
Set olApp = Nothing
Set rst = Nothing
Set db = Nothing
 
Code:
      Set [COLOR="Red"][B]rstAttachments [/B][/COLOR]= db.OpenRecordset("SELECT * FROM tblteaminformer INNER JOIN attachments ON tblteaminformer.TeamID = attachments.linkattatchment")
    
   strteamid = [COLOR=red][B]rst[/B][/COLOR]!TeamID
Back to the previous code, those two should match.

If you add Option Explicit at the top, just below Option Compare Database, you won't have this particular problem.
 
If you add Option Explicit at the top, just below Option Compare Database, you won't have this particular problem.

I can't add Option Explicit at the top as it then causes error with other code within the form

here what I have change still not working error has moved now say runtime error error 424 object required

:banghead::banghead:

here the code
Code:
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment
Dim rstFiltered As DAO.Recordset
Dim strteamid As String
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
  Dim db As DAO.Database
 Dim rstAttachments As DAO.Recordset
With olMail
    .BodyFormat = olFormatHTML
    .To = "" ' Left
    .CC = ""
    .Subject = "test for VbaInet"
    .Body = "VbaInet Help Me "
     'Add Attachments
  
    Set db = CurrentDb()
    
      Set rstAttachments = db.OpenRecordset("SELECT * FROM tblteaminformer INNER JOIN attachments ON tblteaminformer.TeamID = attachments.linkattatchment")
    
[B][COLOR=red]   strteamid = rstattachment!TeamID
[/COLOR][/B]  rst.Filter = "teamid = '" & strteamid & "'"
    Set rstFiltered = rstattachment.OpenRecordset
    
    
    If rstAttachments.RecordCount > 0 Then
        With rstAttachments
            Do Until .EOF
         olMail.Attachments.Add (rstAttachments!txtaddress)
                
                .MoveNext
            Loop
        End With
    End If
     .Save
    .Display
End With
Set olMail = Nothing
Set objOutlookAttach = Nothing
Set olApp = Nothing
Set rstAttachments = Nothing
Set db = Nothing
End Sub
 

Users who are viewing this thread

Back
Top Bottom