Problem -- Non Stop Loop

Discussion in 'Lotus Notes Programming' started by Tina, Apr 26, 2006.

  1. Tina

    Tina Guest

    Hi,
    I have a piece of code written which adds the contents of the e-mail
    in a database and then sends the e-mail.
    Its on the memo form and I have a created a new button called Add and
    send. When the user has finished writing the e-mail he just clicks on
    this button and the e-mail gets stored in a database and is sent out
    simultaneously. The problem is it goes in a loop. So what should happen
    is after clicking the button the e-mail is added and sent and the open
    new memo shoud close automatically.

    Please help...............................

    -Tina
     
    Tina, Apr 26, 2006
    #1
    1. Advertisements

  2. Tina

    JRT Guest

    Can you please provide the code so that we can trace the problem? Also
    how do you know it is looping? Is it continue to send mail or saving
    the e-mail or is it just hung?
     
    JRT, Apr 27, 2006
    #2
    1. Advertisements

  3. Tina

    Tina Guest

    I wrote this in the initialize() . when I click the button it calls an
    object which gets filled with the details of the mail. I select OK on
    that object and an email is sent and this whole process repeats again
    for another time. It happens twice. I hope I am not confusing you.
    The code is pasted below

    Thank

    Dim myConnection
    Dim UIDoc As NotesUIDocument
    Dim ws As New NotesUIWorkspace
    Dim sSubject As String, sBody As String, sDate As String
    Dim sDocBody As String
    Dim bLoggedIn As Variant
    Dim myUnresContacts
    Dim myActType
    Dim nCur As Integer
    Dim nSep As Integer
    Dim session As New NotesSession
    Dim books As Variant
    Dim view As NotesView
    Dim doc As NotesDocument
    Dim Doc2 As NotesDocument
    Dim done As Variant
    Dim person As String
    Dim sUnResContacts As String
    Dim sRet As String
    Dim bRet As Variant
    Dim sTempFileName As String
    Dim sHarvesterEAddr As String
    Dim sInternalContact As String
    Dim db As NotesDatabase
    Dim bNewDoc As Long
    Dim ActType As String


    ' *********************
    ' CHOICE:
    ' You can choose the default Activity Type to use. The code will
    locate the first
    ' Activity type that contains the following string: (case
    insensitive)
    ' *********************
    ActType = "E-MAIL"



    Set db = session.CurrentDatabase
    Const cSepChar = "^~"
    Dim Index As Integer

    Set UIDoc = ws.currentdocument
    On Error Resume Next
    UIDoc.Save
    Set Doc=UIDoc.Document


    If UIDoc.IsNewDoc Then
    bNewDoc=1
    Else
    If Doc.HasItem("PostedDate") Then
    bNewDoc=0
    Else
    bNewDoc=1
    End If
    End If


    sSubject = UIDoc.Fieldgettext("Subject")
    sBody = "From: " & UIDoc.Fieldgettext("DisplayFrom") & Chr(13) &
    Chr(10)
    sbody = sBody & "To: " & UIDoc.Fieldgettext("EnterSendTo") & Chr(13)
    & Chr(10)
    sBody = sBody & "Subject: " & UIDoc.Fieldgettext("Subject") & Chr(13)
    & Chr(10) & Chr(13) & Chr(10)

    On Error Resume Next
    sDocBody=doc.body(0)
    If sDocBody="" Then
    sDocBody=doc.body
    End If
    sBody = sBody & sDocBody

    sBody=sBody & Chr(13) & Chr(10)

    sbody = sbody & GetAttachmentNames(UIDoc.Document)

    sDate = UIDoc.Fieldgettext("DisplayDate")


    If bNewDoc = 1 Then
    sUnResContacts = UIDoc.Fieldgettext("EnterSendTo")
    'sinternalcontact= UIDoc.Fieldgettext("DisplayFrom")
    sInternalContact = session.CommonUserName

    Else

    ' *********************
    ' CHOICE:
    ' Because we cannot determine if an email was Sent by the user or
    Received, we will always
    ' include both the To and From fields. The default separator is a
    COMMA. If your system
    ' is configured to use a different character (such as a semi colon),
    then please change it
    ' in the following line.
    ' *********************
    sUnResContacts = UIDoc.Fieldgettext("DisplayFrom") + "," +
    UIDoc.Fieldgettext("EnterSendTo")

    sInternalContact = session.CommonUserName
    End If

    Set myConnection = CreateObject("EActGenNotes.clsConnection")


    ' *********************
    ' CHOICE:
    ' You have the option of determining if Lotus Notes is online with the
    Notes server,
    ' or you can determine if the Application Server is reachable
    '
    ' The default will determine if the Application server is available
    ' *********************

    'If isOnline() = False Then 'Are we connected to the Notes Server?
    If myConnection.IsInterActionOnline() = False Then

    'This is the offline code
    sHarvesterEAddr = myConnection.GetHarvesterEAddr()

    If sHarvesterEAddr = "" Then
    Msgbox "The harvester email address is not in the registry. You
    must use this feature while online before you can use this feature
    offline."
    Exit Sub
    End If
    Set myConnection.NotesSession = session
    books=session.addressbooks
    Forall b In books
    myConnection.AddAddressbook b
    End Forall

    done = False

    sRet = myConnection.OfflineActivityResolutionDlg(sTempFileName,
    sUnResContacts, ",;", True, ActType, sSubject, sBody, sDate,
    sInternalContact)
    If sRet = "" Then
    End
    End If

    Set doc2 = New NotesDocument( db )
    ' set the new document's form so it'll be readable as a
    mail memo
    doc2.ReplaceItemValue "Form", "Memo"
    ' set the new document's Subject
    doc2.ReplaceItemValue "Subject", ssubject
    ' set the new document's Body
    doc2.ReplaceItemValue "Body", sRet
    doc2.ReplaceItemValue "sendto", sHarvesterEAddr

    'send the new document to the harvester
    Call doc2.send(False, sHarvesterEAddr)

    Else ' We are working Online

    'This is the online code

    ' *********************
    ' CHOICE:
    ' You haave the option of filtering out contacts associated to
    your organization or not.
    ' If you DO NOT want to filter out organization contacts, then
    change the value
    ' on the following line from "true" to "false"
    ' *********************
    myConnection.RemoveOrganizationContacts = True

    bRet = myConnection.OnlineActivityResolutionDlg(sUnResContacts, ",;",
    True, ActType, sSubject, sBody, sDate, sInternalContact)
    If bret = False Then
    'User cancelled
    Exit Sub
    End If
    End If
    UIdoc.Send
    End Sub
     
    Tina, Apr 27, 2006
    #3
  4. Tina

    Tina Guest

    Hi JRT, -----------------Please help
    The program works fine. I took this code out of Intialize and created
    a new procedure called sub sendadd. Now I have another problem. As you
    can see in the above code it calls a function called
    GetAttachmentNames(I am attaching the code below). This is supposed to
    take the attachment in the e-mail and upload it as a link. I am not
    sure why is the link not appearing ........
    Function GetAttachmentNames(Doc As NotesDocument) As String
    Dim x As Variant
    Dim sReturn As String


    x = Evaluate("@AttachmentNames", Doc)
    Forall attName In x
    If attName<>"" Then
    sReturn = sReturn & Chr(13) & Chr(10) & "[Attachment - " & attName
    & " ]"
    End If
    End Forall
    GetAttachmentNames = sReturn
    End Function
     
    Tina, Apr 28, 2006
    #4
  5. Tina

    JRT Guest

    First, @AttachmentNames only extract filenames that are attached in the
    document.

    Second, sReturn is a string, if you really want to upload attachments,
    you need to declare store the attachements as richtextitem. Note that
    you need to make amendment to variable sBody and GetAttachmentNames.

    This is all I can help at the moment.
     
    JRT, Apr 29, 2006
    #5
  6. Tina

    Tina Guest

    Hi JRT,
    This is the code for Uploading the attachments as a link
    Function Copymails(maildoc As notesdocument) As String
    Dim Server As Variant
    Dim Filepath As Variant
    Dim URL As String
    Dim Sn As New NotesSession
    Dim Ws As New NotesUiWorkspace
    Dim Db As notesDatabase
    Dim Dc As NotesDocumentCollection
    Dim Doc As notesDocument, TempDoc As notesDocument
    Dim idx As Long
    Dim Bodyitem As Variant
    Dim auitem As notesitem
    Dim rditem As notesitem
    Dim i As Integer

    On Error Goto ErrorStep
    Set Db = Sn.CurrentDatabase
    'Set TargetDb = Sn.CurrentDatabase
    'Set the Target Db here
    Set TargetDb = New NotesDatabase ( TARGETDBSERVER, TARGETDBPATH )
    If Not TargetDb.isopen() Then
    Copymails="nottargetdbisopen"
    Exit Function
    End If
    Set Dc = Db.UnprocessedDocuments
    If Dc.count=0 Then
    Copymails= "unprocesseddocsero"
    Exit Function
    End If
    Dim PDocIDView
    Set PDocIDView=TargetDb.getview("(memo by PDocID)")
    Set Doc = Dc.getfirstdocument
    For i=1 To dc.count
    If Not Doc Is Nothing Then
    Set tempdoc=PDocIDView.getdocumentbykey(doc.universalid, True)
    If tempdoc Is Nothing Then
    Set TempDoc = New NotesDocument(TargetDb)
    Call Doc.copyallitems(TempDoc, True)
    TempDoc.Form = "Memo"
    Set auitem = New notesitem(tempdoc, "Author", "[Admin]",AUTHORS)
    Call auitem.appendtotextlist(Sn.UserName)
    auitem.isauthors=True
    %REM Commented 01/12/04 by Nitin Verma
    Set rditem = New notesitem(tempdoc, "Reader", "[Admin]",READERS)
    Call rditem.appendtotextlist(Sn.UserName)
    rditem.isreaders=True
    %END REM
    tempdoc.Owner=Sn.UserName
    tempdoc.PDocID=doc.UniversalID
    Call TempDoc.Save(True, True)
    Set maildoc=tempdoc
    End If
    TempDoc.Server = TargetDb.Server
    TempDoc.FilePath = TargetDb.FilePath
    server = Evaluate("@Name([CN];Server)",TempDoc )
    filepath = Evaluate("@ReplaceSubString(FilePath;
    ""\\"";""/"")",TempDoc )

    If Trim(URL$) = "" Then
    URL$ = "http://" + server(0) + "/" + filepath(0)
    +"/($All)/"+TempDoc.UniversalID + "?OpenDocument"
    Else
    URL$ = URL$ & Chr(13) & Chr(10) & "http://" +server(0) + "/" +
    filepath(0) +"/($All)/"+TempDoc.UniversalID +"?OpenDocument"
    End If

    End If
    Set Doc = Dc.getnextdocument(doc)
    Next
    Copymails = URL$
    Exit Function
    ErrorStep:
    Msgbox "Copymails - Following error has occured:
    "+Chr(10)+Error$,,"Error - "+Format$(Err)+" on line# "+Format$(Erl)
    Copymails = "noattachmentshere "
    Exit Function
    End Function


    But whenever I run the program it says "unprocesseddocsero". Can you
    help me out. I tried debugging , but I still can't figure it out.
    What am i doing wrong here.


    Thanks,
     
    Tina, May 8, 2006
    #6
  7. Tina

    JRT Guest

    The "UnprocessedDocuments" works for agents or view actions only. So if
    you have a button within a form (which I assume is similar to the
    original problem of this thread) and use this property, it will also
    return zero count.
    So, please confirm if you are running this code from an agent (check
    the 'trigger' property) or from a view action. If not, you will need
    to modify the code.
    Good luck.
     
    JRT, May 9, 2006
    #7
  8. Tina

    Tina Guest

    I am not running it from the agents or view actions. SO I guess I have
    to change the code.Any hints or sugeestions, what should I change and
    what functions can I use to produce the same effect.

    Thanks for all your help
    -Tina
     
    Tina, May 9, 2006
    #8
  9. Tina

    JRT Guest

    Why do you need to work on "unprocesseddocument"? Does it mean you try
    to select a number of documents from a view and then run this code? If
    it is the case, you can simply:
    - create an view action
    - use this code to find all URL
    - then compose a new document (with the form that you want to store the
    URL) or simple programmatically find the required document and put the
    string into it.

    Also, (hope you don't mind) you can be written to be more efficient,
    faster:
    =====
    TempDoc.Server = TargetDb.Server
    TempDoc.FilePath = TargetDb.FilePath
    server = Evaluate("@Name([CN];Server)",TempDoc )
    filepath = Evaluate("@ReplaceSubString(FilePath;
    ""\\"";""/"")",TempDoc )
    =====
    First, I think the "server" turns out to be the same as
    TargetDB.Server, while the "filepath" is the same as TargetDB.FilePath
    (except the direction of slashes), so the "Evaluate"is not necessary.
    If you do make change, the "server" and "filepath" are now "string"
    rather than variant, ie you don't need to specify server(0).
    Second, as the "server" and "filepath" are always the same for all
    TempDoc, if you move the code outside the "for..loop", then your code
    will execute faster (if you are selecting a number of documents).
     
    JRT, May 10, 2006
    #9
  10. Tina

    Tina Guest

    Thanks for your help.....I don't want to run this from an agent.
    I want it through the button. So i am going to code you suggested.
    TempDoc.Server = TargetDb.Server
    TempDoc.FilePath = TargetDb.FilePath
    server = Evaluate("@Name([CN];Server)",TempDoc )
    filepath = Evaluate("@ReplaceSubString(FilePath;
    ""\\"";""/"")",TempDoc )

    Thanks,
    Trupti
     
    Tina, May 10, 2006
    #10
  11. Tina

    Tina Guest

    Thanks for your help.....I don't want to run this from an agent.
    I want it through the button. So i am going to code you suggested.
    TempDoc.Server = TargetDb.Server
    TempDoc.FilePath = TargetDb.FilePath
    server = Evaluate("@Name([CN];Server)",TempDoc )
    filepath = Evaluate("@ReplaceSubString(FilePath;
    ""\\"";""/"")",TempDoc )

    Thanks,
    Tina
     
    Tina, May 10, 2006
    #11
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.