' you need to add Reference to:
' Microsoft Outlook XX.X Object Library (Tools->Reference)
'
' arnelgp
'
'
' Parameters:
'
' sTable (string) the name of table where the attachment field can be found
' pkName (string) PK or fieldname that uniquely identifies a record
' pkValue (variant) the value of the PK to search
' sAttachmentFiedName (string) the name of attachment field in sTable.
'
Public Function olEmail(sTable As String, pkName As String, pkValue As Variant, sAttachFieldName As String)
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim coll As New Collection
Dim sPath As String
Dim sWhere As String
Dim i As Integer
sPath = Environ("temp") & "\"
Select Case TypeName(pkValue)
Case "string"
sWhere = "[" & pkName & "]=" & Chr(34) & pkValue & Chr(34)
Case "integer", "double", "single", "double"
sWhere = "[" & pkName & "]=" & pkValue
Case "date"
sWhere = "[" & pkName & "]=#" & Format(pkValue, "mm/dd/yyyy") & "#"
End Select
Dim outlookApp As Outlook.Application
Dim outlookMail As Outlook.MailItem
Set rsParent = CurrentDb.OpenRecordset( _
"select [" & sAttachFieldName & "] from [" & sTable & "] " & _
"where " & sWhere, dbOpenSnapshot)
Set rsChild = rsParent.Fields(sAttachFieldName).Value
With rsChild
If Not (.BOF And .EOF) Then .MoveFirst
While Not .EOF
rsChild.Fields("FileData").SaveToFile sPath & rsChild.Fields("FileName")
coll.Add sPath & rsChild.Fields("FileName")
.MoveNext
Wend
.Close
End With
rsParent.Close
Set rsChild = Nothing
Set rsParent = Nothing
Set outlookApp = New Outlook.Application
Set outlookMail = outlookApp.CreateItem(olMailItem)
With outlookMail
'.To=
'.Subject=
'.BodyFormat=
'.Body=
For i = 1 To coll.Count
.Attachments.Add coll.Item(i)
Next
'.Save
'.Send
.Display
End With
End Function