Add it and fix the errors, then come back to this code and look carefully at what you're writing.I can't add Option Explicit at the top as it then causes error with other code within the form
If there's need to see your db I'll let you know, at the moment it's not necessary.
Add it and fix the errors, then come back to this code and look carefully at what you're writing.
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")
strteamid = rstAttachments!TeamID
rstAttachments.Filter = "teamid = '" & strteamid & "'"
[COLOR=red][B] Set rstFiltered = rstAttachments.OpenRecordset
[/B][/COLOR]
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
Use the recordsetclone of your subform. Research RecordsetClone.
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment
Dim rstFiltered As DAO.Recordset
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim rstAttachments As DAO.Recordset
Dim strSearchName As String
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")
Set rst = Me.RecordsetClone
strSearchName = Str(Me!TeamID)
rstAttachments.Filter = "teamid = '" & TeamID & "'"
[COLOR=red][B] Set rstFiltered = rstAttachments.OpenRecordset[/B][/COLOR]
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
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim olAttach As Outlook.Attachment
Dim rstAttach As DAO.Recordset
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
With Me.SubformName.Form
' Commit changes (if necessary)
If .Dirty Then .Dirty = False
' Fetch your subform's recordset
Set rstAttach = .RecordsetClone
End With
' Compose email, attach docs and send
With olMail
.BodyFormat = olFormatHTML
.To = "sspreyer@stanford-le-hope.co.uk"
.CC = ""
.Subject = "sspreyer take your time!"
.Body = "sspreyer, you're getting there"
' Add Attachments
With rstAttach
Do While Not .EOF
olMail.Attachments.Add !PathField
DoEvents
.MoveNext
Loop
End With
.Display
' .Save
' .Send
End With
Set olMail = Nothing
Set olApp = Nothing
Set rstAttach = Nothing
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim olAttach As Outlook.Attachment
Dim rstAttach As DAO.Recordset
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
With Me.attachments_subform.Form
' Commit changes (if necessary)
If .Dirty Then .Dirty = False
' Fetch your subform's recordset
Set rstAttach = .RecordsetClone
End With
' Compose email, attach docs and send
With olMail
.BodyFormat = olFormatHTML
.To = "[EMAIL="sspreyer@stanford-le-hope.co.uk"]sspreyer@stanford-le-hope.co.uk[/EMAIL]"
.CC = ""
.Subject = "sspreyer take your time!"
.Body = "sspreyer, you're getting there"
' Add Attachments
With rstAttach
Do While Not .EOF
[B][COLOR=red]olMail.Attachments.Add !txtaddress[/COLOR][/B]
DoEvents
.MoveNext
Loop
End With
You should be able to debug this. I specifically put PathField but you changed it to the name of the textbox. PathField meaning, the name of the field that contains the path to the file.
A field name with a prefix of "txt", are you sure?
Nope, not yet![]()
Ok, do this:
where strPath is declared as a String variable.Code:strPath = !txtAddress olMail.Attachments.Add strPath, olByValue
Close the mail item window before you re-run the code.
With rstAttach
If .RecordCount > 0 Then
.MoveFirst
Do While Not .EOF
strPath = !txtAddress
olMail.Attachments.Add strPath, olByValue
DoEvents
.MoveNext
Loop
End If
End With
' Fetch your subform's recordset
Set rstAttach = .RecordsetClone
If rstAttach.RecordCount < 1 Then Exit Sub
With rstAttach
.MoveFirst
Do While Not .EOF
strPath = !txtAddress
olMail.Attachments.Add strPath, olByValue
DoEvents
.MoveNext
Loop
End With