SendObject Method in Microsoft (1 Viewer)

[Nancythomas]

I need help

I want to email all attachnments saved in the database as well as the PDF report.
The below script works fine BUT When there is no attachment it does not send the report. How can I amend my script to add an IF and ELSE clause into my script.

--If No attachment (attachment dataType) then send only the report PDF.


Private Sub SaveAttachment(ByRef FilePaths As Variant)
'On Error GoTo Err_Catch
Const PROC_NAME As String = "SaveAttachment()"

' /* Saves the files in the attachment field to a dir */
' /* Creates an array of the paths */

Dim rstSubf As DAO.Recordset
Dim rstAttach As DAO.Recordset2
Dim fldAttach As DAO.Field2
Dim strFilePath As String
Dim strPaths() As String
Dim intPos As Integer
Dim intUbound As Integer

Const STR_REPORT As String = "R1Report"

With Attachment_Frm.Form
If .Dirty Then .Dirty = False
If .Recordset.RecordCount < 1 Then Exit Sub

Set rstSubf = .RecordsetClone
rstSubf.MoveFirst
End With


strFolderPath = CurrentProject.Path & "\ProjectsAttach_"

' Create dir
Set objFso = New FileSystemObject
DelFolder objFso, strFolderPath
objFso.CreateFolder strFolderPath

' Save all files to dir
Do While Not rstSubf.EOF
Set rstAttach = rstSubf![Attachment].Value
With rstAttach
.MoveLast
.MoveFirst

If .RecordCount > 0 Then
If intPos <> 0 Then
intUbound = .RecordCount + UBound(strPaths)
ReDim Preserve strPaths(intUbound) As String
Else
intUbound = .RecordCount
ReDim strPaths(intUbound) As String
End If
End If

Do While Not .EOF
strFilePath = strFolderPath & "\" & !FileName
strPaths(intPos) = strFilePath

.Fields(0).SaveToFile strFilePath
.MoveNext
intPos = intPos + 1
Loop
End With

rstSubf.MoveNext
Loop

' Output to pdf
strFilePath = strFolderPath & "\" & STR_REPORT & ".pdf"
DoCmd.OutputTo acOutputReport, STR_REPORT, acFormatPDF, strFilePath
DoEvents

' Save the last file path
strPaths(UBound(strPaths)) = strFilePath

FilePaths = strPaths

' Cleanup
Set rstAttach = Nothing
Set rstSubf = Nothing
Set objFso = Nothing
Err_Exit:
Exit Sub

Err_Catch:
MsgBox "Error encountered." & vbCrLf & vbCrLf & _
"Code: " & Err.Number & vbCrLf & vbCrLf & _
"Description: " & Err.Description _
, vbExclamation, _
PROC_NAME

If Not objFso Is Nothing Then
DelFolder objFso, strFolderPath
Set objFso = Nothing
End If

Resume Err_Exit
End Sub
Private Sub EmailAttachments_Click()
'On Error GoTo Err_Catch
Const PROC_NAME As String = "EmailAttachments_Click()"

' /* Sends the attachments via Outlook MAPI */

Dim olkApp As Outlook.Application
Dim olkNamespace As Outlook.NameSpace
Dim olkMailItem As Outlook.MailItem
Dim olkFolder As Outlook.Folder
Dim varPaths As Variant
Dim x As Integer

' Save the attachments and get the paths
SaveAttachment varPaths
If Not IsArray(varPaths) Then Exit Sub

Set olkApp = New Outlook.Application
Set olkNamespace = olkApp.GetNamespace("MAPI")
Set olkFolder = olkNamespace.GetDefaultFolder(olFolderInbox)
Set olkMailItem = olkFolder.Items.Add(olMailItem)

' Build the Email to be sent
With olkMailItem
.BodyFormat = olFormatHTML
.To = "your-email@mail.co.au"
.Subject = "Availability Lot for " & Me.AVLOGID & " At " & Me.[Date]
.HTMLBody = "Some text here"

' Add attachments
For x = LBound(varPaths) To UBound(varPaths)
.Attachments.Add varPaths(x)
Next

.Display
End With

' Cleanup
Set objFso = New FileSystemObject
DelFolder objFso, strFolderPath
Set objFso = Nothing
Set olkApp = Nothing

MsgBox "Mail Sent!", vbOKOnly, "Mail Sent"
Err_Exit:
Exit Sub

Err_Catch:
MsgBox "Error encountered." & vbCrLf & vbCrLf & _
"Code: " & Err.Number & vbCrLf & vbCrLf & _
"Description: " & Err.Description _
, vbExclamation, _
PROC_NAME

' // In your error handler, delete the folder created
Set objFso = New FileSystemObject
DelFolder objFso, strFolderPath
Set objFso = Nothing

Resume Err_Exit
End Sub
Private Sub DelFolder(ByRef Fso As Object, FolderPath)
If Fso.FolderExists(FolderPath) Then
Fso.DeleteFolder FolderPath
End If
End Sub

 

[James Deckert]

you're jumping out if there are no attachments.
SaveAttachment varPaths
' remove here If Not IsArray(varPaths) Then Exit Sub

Set olkApp = New Outlook.Application
Set olkNamespace = olkApp.GetNamespace("MAPI")
Set olkFolder = olkNamespace.GetDefaultFolder(olFolderInbox)
Set olkMailItem = olkFolder.Items.Add(olMailItem)

' Build the Email to be sent
With olkMailItem
.BodyFormat = olFormatHTML
.To = "your-email@mail.co.au"
.Subject = "Availability Lot for " & Me.AVLOGID & " At " & Me.[Date]
.HTMLBody = "Some text here"

' Add attachments
' place if here
If IsArray(varPaths) Then
For x = LBound(varPaths) To UBound(varPaths)
.Attachments.Add varPaths(x)
Next
end if

.Display
End With

 

[Nancythomas]

Thanks James
but this is not what I want.

I have attachments that is (Data type) and I have a access Report as well that get emailed.

Currently only when there are attachment (Data Type) and access report the email works.

I would like the cmd to work when there is not attachment (data type) available it should only send the access report.

Example :

' Output to pdf
strFilePath = strFolderPath & "\" & STR_REPORT & ".pdf"
DoCmd.OutputTo acOutputReport, STR_REPORT, acFormatPDF, strFilePath
DoEvents

The above should work when there are no data type attachment files are available.