Solved Out Of Memory error when emailing (1 Viewer)

oxicottin

Learning by pecking away....
Local time
Today, 10:25
Joined
Jun 26, 2007
Messages
878
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!

Capture.JPG


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
 

Attachments

  • Capture.JPG
    Capture.JPG
    12.7 KB · Views: 19
Have you looked to see what is open and what is taking up memory?
 
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!

View attachment 116208

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
Which version and build of Microsoft Access do you have installed?
 
I got it fixed changing the way I do it...

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
'--------------------------------------------------------------------------------------------------
'Save record
        If Me.Dirty Then
            Me.Dirty = False
        End If
        
        SendSafetyObservationOutlookEmail
        
    End If
End Sub

Public Sub SendSafetyObservationOutlookEmail()
'--------------------------------------------------------------------------------------------------
'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 sEmailList, stSubject, stBody, stText, stClassification, stCreatedBy, stObservationNum, sAttachmentName, sExistingReportName, myCurrentDir, myReportOutput As String
    Dim myMail As Outlook.MailItem
    Dim myOutlApp As Outlook.Application
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
'----------------------------------------------------------Start of save & rename.pdf
'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
    
'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
    
'Full path to temp .pdf
    myCurrentDir = "C:\Documents and Settings\" & Environ("username") & "\Desktop\"
    
'Output the .pdf file
    myReportOutput = myCurrentDir & sAttachmentName & ".pdf"
    
    If Dir(myReportOutput) <> "" Then    'The file already exists delete it first.
        VBA.SetAttr myReportOutput, vbNormal    'Remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill myReportOutput    'Delete the file.
    End If
    DoCmd.OutputTo acOutputReport, sExistingReportName, acFormatPDF, myReportOutput
    
'Close hidden open .pdf(s) report
    DoCmd.Close acReport, sExistingReportName
'----------------------------------------------------------End of save & rename.pdf
    
'Create an Outlook-Instance and a new Mailitem
    Set myOutlApp = New Outlook.Application
    Set myMail = myOutlApp.CreateItem(olMailItem)
    
    stClassification = Nz(Me.txtClassification)
    stObservationNum = Me.txtSafetyObserID
    stCreatedBy = fOSUserName()
    
    stSubject = ":: New/Revised " & stClassification & " ::"
    stBody = "A new or revised " & stClassification & " has been created or edited." & Chr$(13) & _
    "Please review the .pdf document with your team members and images if available." & Chr$(13) & Chr$(13) & _
    "Classification:  " & stClassification & Chr$(13) & Chr$(13) & _
    "Observation Number:  " & stObservationNum & Chr$(13) & Chr$(13) & _
    "Edited or Created By: " & stCreatedBy
    
'Loop through emails in tbl_LoginUser to attach as sEmailList
    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
            Do Until .EOF
                sEmailList = sEmailList & "; " & .Fields("strSecurityEmail")
                .MoveNext
            Loop
        End If
        .Close
    End With
    
    With myMail
        .To = sEmailList
        .Subject = stSubject
        .Body = stBody
        .Attachments.Add myReportOutput
        .Display 'Display the email
'.Send 'Send the email without prompts
    End With
    
'Delete the .pdf saved in the DB subfolder
    Kill (myReportOutput)
    
'Set object variables to nothing and free the memory
    Set myMail = Nothing
    Set myOutlApp = Nothing
    db.Close
    Set rs = Nothing
    Set db = Nothing
    
End Sub
 
Not even going to try and compare all of that code. :(
Are you able just to say what you changed?

It might help someone else in the future?, you never know.
 
The way it saved... I saved it to my desktop (renamed) then attached it and deleted the copy on my desktop. I also separated the validation check and if passed then it runs the sub
 
Just an update to help others.....

Well, I was getting another error that OutputTo failed... and took me to this line:

Code:
DoCmd.OutputTo acOutputReport, sExistingReportName, acFormatPDF, myReportOutput

It's because in the "sAttachmentName" there were special characters like "/" that isn't allowed in a name when saving the PDF. I fixed by adding the error handler code below. lol I couldn't figure out why sometimes it failed and sometimes it didn't.

Code:
Error_Handler:
    Select Case Err
    Case 2501
        MsgBox "You can't have special characters in your title, please remove the characters and try again!", vbCritical, "Email Send Error"
        Resume Error_Handler_Exit  'Exit the Sub
    Case Else
        MsgBox "There was an error (" & Err & ")  " & Error
    End Select
 
Well done, and thanks for posting your solution. (y)
I have some code somewhere that removes characters not allowed in filenames, but it is probably just as easy to create your own.
If you do not want to do that, i will try and find it for you.
 
Well done, and thanks for posting your solution. (y)
I have some code somewhere that removes characters not allowed in filenames, but it is probably just as easy to create your own.
If you do not want to do that, i will try and find it for you.
Thanks, I have some code I use for that already saved, I didn't think of not allowing special characters in a title because I never thought I would be saving as a pdf...

Code:
Private Sub txtSampleNum_KeyPress(KeyAscii As Integer)
    Dim LResult As String
    '********************************************************************************
    ' Checks to see if only a number value was entered and no decimals allowed
    ' http://instructional1.calstatela.edu/dweiss/Psy409/key_codes.htm
    ' Chr(KeyAscii) displays the key pressed
    '********************************************************************************
    Select Case KeyAscii
    Case 46    'Period Key
        MsgBox "The Charactor " & Chr(KeyAscii) & " is not allowed!" & vbCrLf & _
               "Only numeric values are permitted"
        SendKeys "{BACKSPACE}"
    Case 65 To 90, 97 To 122    'A-Z and a-z are not allowed
        MsgBox "The letter " & Chr(KeyAscii) & " is not allowed!" & vbCrLf & _
               "Only numeric values permitted"
        SendKeys "{BACKSPACE}"
    Case 32 To 45, 47, 58 To 64, 91 To 96, 123 To 190    'Other Charactors not allowed
        MsgBox "The Charactor " & Chr(KeyAscii) & " is not allowed!" & vbCrLf & _
               "Only numeric values are permitted"
        SendKeys "{BACKSPACE}"
    Case Else
    End Select
End Sub
 

Users who are viewing this thread

Back
Top Bottom