oxicottin
Learning by pecking away....
- Local time
- Today, 07:34
- Joined
- Jun 26, 2007
- Messages
- 883
Hello, I recently have gotten this error message that im out of memory when trying to send a report through Outlook. I have been using this program for a few years now and periodically have seen it and my work around was to save it to my desktop and send by attaching but that defeats the purpose of having a button to send it with a list of emails already there etc.
What in the code below could be causing this and how can I fix it OR what in the code could make it run better and possibly take the error away? Thanks!
What in the code below could be causing this and how can I fix it OR what in the code could make it run better and possibly take the error away? Thanks!
Code:
Private Sub cmdSendEmail_Click()
'Make sure there is a record
If IsNull(Me.SafetyObserID) Then
MsgBox "How can you email data if there isnt any data filled out to email?", vbInformation, "No Data"
Exit Sub
End If
'Valadates controls and if data is missing then it cancels the email
Dim Cancel As Integer
If VerifyObservationEntryForm(Me) = True Then
Cancel = True
ElseIf VerifyEmailorPrintObservationEntryForm(Me) = True Then
Cancel = True
Else
'--------------------------------------------------------------------------------------------------
'Function to email the report either using outlook _
Uses the table tbl_EmailAddress to retrieve the email address to send
'Rename attachment in SendObect Method _
http://www.devhut.net/2012/08/16/ms-access-vba-rename-attachment-in-sendobect-method/
'--------------------------------------------------------------------------------------------------
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sEmailList As String
Dim stSubject As String
Dim stText As String
Dim stClassification As String
Dim stCreatedBy As String
Dim stObservationNum As String
Dim sExistingReportName As String
Dim sAttachmentName As String
'Input variables
sExistingReportName = "rpt_SafetyObservationEntry" 'Name of the Access report Object to send
sAttachmentName = Me.txtSafetyObserID & "-" & Me.txtClassification 'Name to be used for the attachment in the e-mail
stClassification = Nz(Me.txtClassification)
stObservationNum = Me.txtSafetyObserID
stCreatedBy = fOSUserName()
stSubject = ":: New/Revised " & stClassification & " ::"
stText = "A new or revised Observation Entry has been created or edited." & Chr$(13) & _
"Please review the document with your team members." & Chr$(13) & Chr$(13) & _
"Classification: " & stClassification & Chr$(13) & Chr$(13) & _
"Observation Number: " & stObservationNum & Chr$(13) & Chr$(13) & _
"Edited or Created By: " & stCreatedBy
Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT tbl_LoginUser.strSecurityEmail, tbl_LoginUser.UserSecurityType " & vbCrLf & _
"FROM tbl_LoginUser " & vbCrLf & _
"WHERE (((tbl_LoginUser.IsOnEmailList)=True));") 'Email only needed employees from tbl_LoginUser
With rs
If (Not .BOF) And (Not .EOF) Then
.MoveFirst
sEmailList = .Fields("strSecurityEmail")
.MoveNext
End If
If (Not .BOF) And (Not .EOF) Then
Do Until .EOF
sEmailList = sEmailList & "; " & .Fields("strSecurityEmail")
.MoveNext
Loop
End If
.Close
End With
'Save record
If Me.Dirty Then
Me.Dirty = False
End If
'By changing the report caption you effectively change the name used for the attachment in the .SendObject method
DoCmd.OpenReport sExistingReportName, acViewPreview, , "[SafetyObserID]=" & Me![txtSafetyObserID], acHidden
Reports(sExistingReportName).Caption = sAttachmentName
'Write the e-mail content for sending to assignee
'Use [rpt_SelectedEntry] to gather information needed for the emails .pdf attachment.
On Error Resume Next
DoCmd.SendObject acReport, sExistingReportName, acFormatPDF, sEmailList, "", "", stSubject, stText, True, ""
'Close hidden open report
DoCmd.Close acReport, sExistingReportName
db.Close
Set rs = Nothing
Set db = Nothing
End If
End Sub
