Results 1 to 4 of 4
  1. #1
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740

    Unanswered: DESPERATE! problems with .SendObject #1

    i have a mailing list programme - from time to time it mails each member his/her "profile" to make sure their subscriptions, address, phone etc are up to date.

    if i set True(edit the mail)
    first (of 300) mails is generated 100% correctly
    second mail crashes with RunTimeError 2958 - Reserved Error


    False(send without editing) is another problem to be discussed in post #2

    here's the code. some explanations follow at the end

    Code:
    Private Sub butOK_Click()
        On Error GoTo err_butOK
     
        Dim isSubj As String
        Dim isBody As String
        Dim isMail As String
        
        Dim dabs As DAO.Database
        Dim recs As DAO.Recordset
        
        'get mail subject and body-text from the form
        isSubj = wotSubj.Value
        isBody = wotText.Value & vbCrLf & vbCrLf & fixText.Caption
     
        Set dabs = CurrentDb
        Set recs = dabs.OpenRecordset("qrySendProfileList")
        
        With recs
            .MoveLast
            .MoveFirst
            Do While Not .EOF
                boxID.Value = !personID
                If Not IsNull(![E-MAIL]) Then
                    boxTo.Value = ![E-MAIL]
                    isMail = ![E-MAIL]
                    Me.Requery
                    junk = DoEvents()
                    If Len(isMail) > 0 Then
                        DoCmd.SendObject acSendReport, "rptSendProfile", "Snapshot Format", isMail, , , isSubj, isBody, True
                        'DoCmd.OpenReport "rptSendProfile", acViewPreview
                        
                DEVcounter = DEVcounter + 1     'dont need all 300 for testing purposes
                If DEVcounter > 9 Then Exit Sub 'so quit after the first few
                                          
                        DoCmd.Close acReport, "rptSendProfile"
                    End If
                End If
                
                
                .MoveNext
            Loop
        End With
        
    exit_butOK:
        Set recs = Nothing
        Set dabs = Nothing
        Exit Sub
        
    err_butOK:
        MsgBox Err.Description & "DC=" & DEVcounter
        Resume exit_butOK
        
    End Sub

    EVERYTHING works if i comment the .SendObject and uncomment the .OpenReport
    ....so I am pretty sure the problem is with the .SendObject line

    wotSubj; wotText are valid text boxes on the current form, correctly filled with valid strings. fixText is a label correctly filled with a valid string. all three correctly copy to vars isSubj; isBody

    the query qrySendProfileList gets PersonID, E_MAIL fields for the mailing targets: it works! boxID; boxTo text boxes on the form correctly display these data. the E-MAIL data correctly copies to var isMail

    the report rptSendProfile works fine in acPreview. it feeds on qrySendProfile which gets it's critera from boxID.value on the form


    (a very confused) izy
    Last edited by izyrider; 03-07-03 at 13:11.

  2. #2
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740

    Re: DESPERATE! problems with .SendObject #1

    http://support.microsoft.com/default...;en-us;q260819
    says:

    Runtime Error 2958 "Reserved error"
    CAUSE
    This behavior can occur if either of the following conditions is true:
    There are too many characters in the message. This behavior has been documented with messages that contain between 70 and 2268 characters. Note This number may be higher or lower on each computer.
    -or-
    The SendObject method runs more than one time in a procedure.

    working on the workarounds. izy

  3. #3
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740

    Re: DESPERATE! problems with .SendObject #1

    seems i'm mostly talking to myself, but anyhow - here's the fix that worked in case someone else has the same hassle.

    abandon .sendobject and work with outlook directly. code is modified from other posts elsewhere on this site.

    BTW there are unfortunate interferences from outlook security: either you send-immediate and put up with delay dialogs of 5 seconds per message or you save to draft and send each message from Outlook later.

    ...but it works.

    izy

    Code:
    Private Sub butOK_Click()
        On Error GoTo err_butOK
        
        'drive:\path\name.SNP of the profiles report
        Const snpName = "c:\commguide\profile.snp"
        
        'prepare to drive outlook
        Dim objOutlook As Outlook.Application
        Dim objOutlookMsg As Outlook.MailItem
        Dim objOutlookRecip As Outlook.Recipient
        Dim objOutlookAttach As Outlook.Attachment
        
        Dim isSubj As String    'subject from me.wotSubj
        Dim isBody As String    'body from me.wotText, .wotSign + other fixed text
        Dim isMail As String    'TO from recs!E-MAIL
        
        Dim dabs As DAO.Database
        Dim recs As DAO.Recordset
        
        'get mail subject and body-text from the form
        isSubj = wotSubj.Value
        isBody = "Dear Colleague," & vbCrLf & vbCrLf & wotText.Value & vbCrLf & vbCrLf & "regards, "
        isBody = isBody & wotSign.Value & vbCrLf & vbCrLf & fixText.Caption & vbCrLf & vbCrLf
    
        'create the branch-office recordset
        Set dabs = CurrentDb
        Set recs = dabs.OpenRecordset("qrySendProfileOffice") 'excludes isDel/isExcl & nulls
        
        'create the outlook session
        Set objOutlook = CreateObject("Outlook.Application")
        
        With recs
            .MoveLast
            .MoveFirst
            Do While Not .EOF                   'step through each branch-office
                wotBra.Value = !BranchID        'grab BranchID for report query criteria
                wotTo.Value = ![E-MAIL]         'grab the e-mail address
                If Len(wotTo.Value) > 0 Then    'ignore empty e-mail addresses
                    
                    'generate a report file to disk for people at Branch wotBra.value 
                    DoCmd.OutputTo acOutputReport, "rptSendOfficeProfiles", "Snapshot Format", snpName
                    
                    'generate the message
                    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
                    Set objOutlookRecip = objOutlookMsg.Recipients.Add(wotTo.Value)
                    objOutlookRecip.Type = olTo
                    objOutlookMsg.Subject = isSubj
                    objOutlookMsg.Body = isBody
                    
                    'attach the profile report
                    If Not IsMissing(snpName) Then
                        Set objOutlookAttach = objOutlookMsg.Attachments.Add(snpName)
                    End If
                    
                    objOutlookMsg.Save 'saved unsent in drafts folder,  unless...
                    If DrSe.Value = 2 Then objOutlookMsg.Send	'...send immediate
                    
                End If
                .MoveNext
            Loop
        End With
        
        If DrSe.Value = 1 Then
            MsgBox "Profile messages have been saved in your Drafts folder.", vbOKOnly, "Send Profile"
        Else
            MsgBox "Profile messages have been sent.", vbOKOnly, "Send Profile"
        End If
        
    exit_butOK:
        Set objOutlook = Nothing
        Set recs = Nothing
        Set dabs = Nothing
        Exit Sub
        
    err_butOK:
        MsgBox Err.Description, vbCritical, "Error sending profile"
        Resume exit_butOK
        
    End Sub

  4. #4
    Join Date
    Oct 2002
    Location
    Leicester - UK
    Posts
    820
    i've done something simalar with
    Private Sub send_Click()
    Dim Message As String
    Dim rs As DAO.Recordset
    Dim email As Outlook.MailItem
    Set email = CreateObject("Outlook.Application").CreateItem(olM ailItem)
    With Form_ByStatus
    Select Case .Status
    Case 1
    Message = "We have Received you Email and will deal with the problem as soon as possible."
    Case 2
    Message = "We are currently working on fixing your problem."
    If Form_Tasks.Count > 0 Then
    Set rs = Form_Tasks.Recordset
    rs.MoveLast
    Message = Message & " The next action tobe taken is " & rs("ActionToBeTaken").Value
    End If
    Case 3
    Message = "This is to inform you that we have solved the problem."
    GoTo a:
    End Select
    If .EstimatedFixDate = "" Then
    Message = Message & " Unfortunately we are Currently unable to predict when we'll fix the problem"
    Else
    Message = Message & " We hope have the problem fixed by " & .EstimatedFixDate
    End If
    a: Message = Message & vbCrLf & vbCrLf & "Original Message:" & vbCrLf & .DescriptionFull
    'DoCmd.SendObject , , , Replace(.User, " ", ".") & "@uk.agimedia.com", , , "Ref: " & .Refference & " RE:" & .DescriptionBrief, Message
    email.To = Replace(.User, " ", ".") & "@uk.agimedia.com"
    email.Subject = "Ref: " & .Refference & " RE:" & .DescriptionBrief
    email.Body = Message
    email.Send

    End With
    Cancel_Click
    End Sub
    Definition of a Beginner, Someone who doesn't know the rules.

    Definition of an Expert, Someone who knows when to ignore the rules.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •