vb code to use Redemption

Heartless91
Heartless91 used Ask the Experts™
on
I am trying to modify some code to work with Redemption. I have most of it working  as it will cycle through the first student but then it hangs in the loop for the second email giving me an error # -2147024891 … appropriate permission to perform this operation I don't understand it well enough to see what is causing the error.
Option Compare Database
Option Explicit


Private dbs As DAO.Database
Private qdf As DAO.QueryDef
Private rst As DAO.Recordset


Public Sub SendInterventionEmails()
'Created by Helen Feddema 10-Jan-2010
'Last modified by Helen Feddema 10-Jan-2010

On Error GoTo ErrorHandler

   'Dim appOutlook As New Outlook.Application
   'Dim itm As Outlook.MailItem
   
'Redemption Effort
    Dim Attachment As String
    
   Dim olApp As New Outlook.Application 'Redemption Effort
   Dim olNS As Outlook.NameSpace 'Redemption Effort
   Dim olFolder As Outlook.MAPIFolder ' Redemption Effort
   Dim olMailItem As Outlook.MailItem 'Redemption Effort
   Dim olAttachment As Outlook.Attachment 'Redemtption Effort
        'add a reference to the Redemption Safe Mail Item
    Dim objSafeMail As Redemption.SafeMailItem 'Redemtption Effort
    Set olApp = CreateObject("Outlook.application") 'Redemtption Effort
    Set olNS = olApp.GetNamespace("MAPI") 'Redemtption Effort
    Set olFolder = olNS.GetDefaultFolder(olFolderInbox) 'Redemtption Effort
    Set olMailItem = olFolder.Items.Add 'Redemtption Effort

   Dim rstIntervention As DAO.Recordset
   Dim lngCount As Long
   Dim lngID As Long
   Dim rpt As Access.Report
   Dim strFileName As String
   Dim strPrompt As String
   Dim strQuery As String
   Dim strRecordSource As String
   Dim strReport As String
   Dim strSQL As String
   Dim strTitle As String
   Dim strCurrentPath As String
   Dim strFileNameAndPath As String
   Dim strEmailSource As String
   Dim Recipient As String
   Dim BodyTxt As String
      
   strEmailSource = "qryInterventionEmail"
   strRecordSource = "qryMissingAssignments"
   strQuery = "qryMissingAssignmentsSingleStudent"
   Set dbs = CurrentDb
   Set rstIntervention = dbs.OpenRecordset(strEmailSource)
   strCurrentPath = Application.CurrentProject.Path & "\"
   
   With rstIntervention
      Do While Not .EOF
         lngID = ![StID]
         Debug.Print "Processing Student ID " & lngID
         strFileName = Format(Now(), "YYYYMMDD") & " " & "Intervention Report for " & Trim(![StFirst]) _
            & " " & Trim(![StLast]) & ".pdf"
         strFileNameAndPath = strCurrentPath & strFileName
         
         'Create filtered query
         strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _
            & "[StID] = " & Chr(39) & lngID & Chr(39) & ";"
         Debug.Print "SQL for " & strQuery & ": " & strSQL
         lngCount = CreateAndTestQuery(strQuery, strSQL)
         Debug.Print "No. of items found: " & lngCount
         If lngCount = 0 Then
            GoTo NextStudent
         End If
      
         'Use SQL string as the record source of a report
         strReport = "rptMissingAssignmentsNew"
         DoCmd.OpenReport ReportName:=strReport, _
            View:=acViewPreview, _
            windowmode:=acWindowNormal
         Set rpt = Reports(strReport)
         DoCmd.OutputTo objecttype:=acOutputReport, _
            objectname:=strReport, _
            outputformat:=acFormatPDF, _
            outputfile:=strFileNameAndPath
            
' Commenting out Helen's Code to try redemption
'         'Create email
'         Set itm = appOutlook.CreateItem(olMailItem)
'         itm.Subject = "You have been assigned to Intervention"
'         itm.Body = "You have been assigned to Intervention for " & ![DateToRpt] & ", Period " & ![PdToRpt] _
'                  & ". Attached is a file showing your missing assignments."
'         itm.To = ![Email]
'         itm.Attachments.Add Source:=strFileNameAndPath, _
'            Type:=olByValue
'
'         'For editing before sending
'         itm.Display
'
'         'For sending automatically
         'itm.Send
         
' Trying the redemption code
Recipient = "eharman@ohp.k12.oh.us"
BodyText = "You have been assigned to Intervention for " & vbNewLine & vbNewLine _
            & "Date to Report     " & ![DateToRpt] & vbNewLine _
            & "Period to Report   " & ![PdToRpt] & vbNewLine & vbNewLine _
            & "Attached is a file showing your missing assignments."
 With olMailItem
        .Subject = "You have been assigned to Intervention"
'        .To = ![Email]
        .To = Recipient
        .Body = BodyText
'        If Attachment <> "" Then
           Set olAttachment = .Attachments.Add(strFileNameAndPath)
'        End If
    End With
    Set objSafeMail = New Redemption.SafeMailItem
    objSafeMail.Item = olMailItem
    objSafeMail.Send
         
         DoCmd.Close objecttype:=acReport, _
            objectname:=strReport, _
            Save:=acSaveNo

NextStudent:
         .MoveNext
      Loop
   End With
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in SendInterventionEmails procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

Set objSafeMail = Nothing
Set olMailItem = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
    
End Sub

Public Function CreateAndTestQuery(strTestQuery As String, _
   strTestSQL As String) As Long
'Created by Helen Feddema 28-Jul-2002
'Last modified by Helen Feddema 10-Jan-2010

On Error Resume Next
   
   'Delete old query
   Set dbs = CurrentDb
   dbs.QueryDefs.Delete strTestQuery

On Error GoTo ErrorHandler
   
   'Create new query
   Set qdf = dbs.CreateQueryDef(strTestQuery, strTestSQL)
   
   'Test whether there are any records
   'Set rst = dbs.OpenRecordset(strTestQuery)
   Set rst = qdf.OpenRecordset(dbOpenDynaset, dbSeeChanges)
   With rst
      .MoveFirst
      .MoveLast
      CreateAndTestQuery = .RecordCount
   End With
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   If Err.Number = 3021 Then
      CreateAndTestQuery = 0
      Resume ErrorHandlerExit
   Else
   MsgBox "Error No: " & Err.Number _
      & " in CreateAndTestQuery procedure; " _
      & "Description: " & Err.Description
   End If
   
End Function

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2010

Commented:
Hi, heartless91.

What line does the error occur on?

Author

Commented:
Exposing my ignorance. How would I "step into???" the code so it would identify the line?
Top Expert 2010

Commented:
Heartless91 said:
>>Exposing my ignorance. How would I "step into???" the code so it would identify the line?

On the runtime error dialog, click Debug, and then tell us what line the debugger jumps to.
Success in ‘20 With a Profitable Pricing Strategy

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Author

Commented:
I have the program sending the emails to me so the students don't get concerned about all the "bogus" emails. The program cycles through the first student without error. It starts on the second student but gives me "Error No: - 2147024891 in SendInterventionEmails procedure; Description: You don't have appropriate permission to perform this operation." It has only an "OK" button so it does not highlight the line of code that is stopping the execution.

I have been experimenting with location of code to try to make it work. Should the line of code "    Dim olApp As New Outlook.Application 'Redemption Effort" somehow be rewritten so a new application is open for each cycle of the student emails? (Just reaching for straws.) It appears that Outlook doesn't like the command set the second time around.
Top Expert 2010

Commented:
If SendInterventionEmails is a standalone procedure (i.e. it's not being called by soem other procedure), then here's how to step through the code.

1.  Open the code in the VBA editor.
2.  Place the insertion point somewhere within that procedure.
3.  Press F8 to being a line-by-line debugging process.
4.  Each time you press F8 it will execute the highlighted line of code and step to the next line
5.  Repeat the process until the error occurs.

From the error message it's pretty hard to figure out the problem without knowing where it's occurring.

Author

Commented:
It appears to hang at the "If attachment <> "" Then" statement which I had commented out the If statement so that it automatically added the attachment. When I had the If condition uncommented, it would not attach the file to the email.
Top Expert 2010

Commented:
I think the problem is a wrong variable name (Attachment instead of .Attachment).  That line should probably read

If .Attachment <> "" Then

But I'm also confused.  That line is commented out.  The code can't fail on a comment.  Are you saying that it was failing there and you just commented it out?

Author

Commented:
I won't be able to test this until Monday when I'm back at school as I only have Redemption on my laptop. I'm hoping your correction for .attachment is the solution. I had commented out the "If" portion of the code because it wouldn't attach the pdf. The second cycle through the code appeared to produce the error at the next line:

Set olAttachment = .Attachments.Add(strFileNameAndPath)

I don't understand why I would get a permissions error when it comes to attaching a file (that it did successfully create) but the above line was where it generated the error.

I will be in a position to test this around 7:30 EST on Monday.
Thanks
Top Expert 2010

Commented:
No problem.

Author

Commented:
I changed the code to read: "If  .Attachment <> "" Then" . The error seems to be in this statement because it now jumps to the permission error message on the first cycle. It appears that the .Attachment IS equal to "" is creating the error.
Top Expert 2010

Commented:
Ok.  How about changing the reference from .Attachment to .Attachment.Filename?

Author

Commented:
If I try...  If Attachment <> "" Then... I get the value 'Attachment=""' and it send the email without the attachment.
If I try...  If .Attachments <> "" Then... It goes directly to error handling and does not email anything.
If I try...  If .Attachments(strFileNameAndPath) <> "" Then... It goes directly to error handling and does not email anything.
If I try...  If .Attachments.strFileNameAndPath <> "" Then... It goes directly to error handling and does not email anything.
If I try...  If strFileNameAndPath <> "" Then... It sends the email for the first student but not the second. It does go into the loop so the value is changing. It does not exit the loop so I am GUESSING that there is something wrong with the attachment. When I compare the files that have been created, I cannot discern any differences other than the data that is unique to each file. Is there something missing that needs to be added to the code? Is the creation of the file too slow to where the file isn't ready when the call for the attachment is made?
Top Expert 2010

Commented:
There is no such thing as ".Attachment.strFileNameAndPath".  An attachment is an object.  Objects have properties.  The attachment object does not have a property named strFileNameAndPath.  It does have a property named Filename.  Please try that.  Something like

    If .Attachment.Filename <> "" Then

Author

Commented:
The good thing about Experts-Exchange is the patient guidance of the experts. The bad thing about Experts-Exchange is that my ignorance is exposed to the world.

I have tried your recommendation but it does not work (Error No: 438 in SendInterventionEmails procedure; Description: Object doesn't support this property or method). When I begin typing the code, it will prompt me for ".Attachments" which does not have a Filename property. Do I need to add another reference to the library?

Author

Commented:
If I try... If .Attachments.Count <> 0 Then... It cycles through the first record successfully but hangs on the second.

Author

Commented:
The .Attachments.Count always has a value of 0 so it doesn't work - but you already knew that. The interesting thing is, that in bypassing the loop, the error occurs at ...      objSafeMail.Send. It goes from that line to the error message and bypasses...        
            DoCmd.Close objecttype:=acReport, _
            objectname:=strReport, _
            Save:=acSaveNo
The error message is the permissions error -2147024891.
Top Expert 2010

Commented:
"When I begin typing the code, it will prompt me for ".Attachments" which does not have a Filename property."

That's correct.  Attachments (plural) is a collection of Attachment objects.  The Attachments collection does not have a Filename property. An Attachment object does.  However, if Attachments.Count = 0, then there are no attachments.  

Author

Commented:
I will continue to battle with it. I can bypass the the if statement for now and concentrate on the permissions error that occurs on the second student. Since I've proven my level of (in)competence with vb, it is understandable that my inexperience with Redemption is even greater.  Is it possible that the code after the the attachment is flawed for the subsequent loops? I am questioning...    Set objSafeMail = New Redemption.SafeMailItem... It would make sense that "New" is required to create a new email but I'm not sure. Do I need to clear a value before the next student email can be processed? I spent some time at the Redemption site and even asked for some clarification but I have not received a response.

Thanks
Top Expert 2010

Commented:
"Is it possible that the code after the the attachment is flawed for the subsequent loops?"
That wouldn't cause a permissions error.

"It would make sense that "New" is required to create a new email but I'm not sure."
That's correct.  "New" creates a new, empty mail object.

"Do I need to clear a value before the next student email can be processed?"
Clearing variables is always a good idea.  That prevents the values from one loop affecting the next pass.  I don't know that's the problem though.  I can't actually step through the process.  I can only look at the logic.

Author

Commented:
The error appears to be in line 115 - "Set olAttachment = .Attachments.Add(strFileNameAndPath)".
It runs through the code without error on the first student. On the second pass, it will hit this line and then skip to the error code.

Author

Commented:
Is there another option besides Redemption?
Top Expert 2010

Commented:
I doubt that Redemption is the problem.  It's more likely that there's something wrong with the file the code is trying to attach.  Maybe that file is open.  Maybe the path or file name is wrong.  Have you checked those possibilities?  Have you tried changing the file name and path to see if it will work with some other file?

Author

Commented:
I'll double-check it when I get back to school on Tuesday. The code posted above runs the query, creates the file, and then attaches the file to the email so the same path and filename used to create the file is also used to attach the file. Good suggestion. I'll let you know on Tuesday - unless we have another winter storm.

Author

Commented:
Finally back at school - with another storm coming in this weekend. As I step through the code, I do not see anything that would cause it to fail. The variables are picking up the new values. I am watching as the code creates a new pdf for each student but it fails on the second. Is there something that needs to be reset in the Redemption code to allow for the second email? I'm reaching...
Top Expert 2010
Commented:
Nothing that I know of.  No harm in trying that though.  Try clearing the Redemption objects used in the loop like this

    Set RedemptionObjectName = Nothing

at the bottom of the loop.

Author

Commented:
If I move any or all of " lines, I get an error (91-Object variable or With block variable not set) before it even gets to the send code. If I move them back to the end of the program, I'm back to the original error message that generated this EE question. I am getting frustrated.
Top Expert 2010

Commented:
Can you upload a copy of the database so I can test the process?

Author

Commented:
It will take me a while to "dummy the data" but I'll get it to you. It may exceed EE limits.
Top Expert 2010

Commented:
Just need two or three records in the database.

Author

Commented:
I am working to clean up the database. All the tables are linked so I have to make some modifications anyway. How will I get the db to you?
Top Expert 2010

Commented:
You can upload it here.

Author

Commented:
Snow days and higher school priorities has me scrambling to spend time modifying the db. I'm still working on it.
Top Expert 2010

Commented:
Ok.

Author

Commented:
Data is minimal. I replaced all links with tables and reduced table size as much as possible. If you open the switchboard, there is a button for emailing students on the far right column (visible to only two of us). Thanks.
Intervention2009.zip

Author

Commented:
I don't think it would matter but in trying to provide all information... all the tables, on my copy, are linked to two SQL servers depending on the data they are retrieving. One server is off-site.

The original code you will see was written by Helen. Everything worked with it except for the send feature.
I have found the solution. It was in front of me all along.
Top Expert 2010

Commented:
No problem.  Glad you found the problem.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial