none
Using VBA to change from Lotus Notes to Outlook. RRS feed

  • Question

  • We have a database that currently uses Lotus Notes when creating a requisition. We have changed over to Outlook 2010 but I dont know how to get the code changed to where the vba uses outlook now instead of lotus notes.

    Here is the code:

    Option Compare Database
    Option Explicit
    
    Public mobjDB As Object
    Public Const Parters = 1
    Public Const Approvers = 2
    
    
    'this sub will: output a report as a file
    'attach the file and add the predetermined subject and body
    'email the designated person for that type of message
    'delete the file that was output
    'close the session with the server
    
    Public Function SEND_EMAIL(ByVal ReportName As String, Subject As String, RecipientList As Integer, message As String) As Boolean
    
        'open the session with the lotus notes server
        SEND_EMAIL = True
        
        If OPEN_SESSION Then
        
            'output report to text file on C:\
    '        DoCmd.OutputTo acOutputReport, ReportName, acFormatRTF, "C:\tempreport.rtf", False
            DoCmd.OutputTo acOutputReport, ReportName, acFormatTXT, "C:\tempreport.txt", False
    
    '       DoCmd.OutputTo acOutputReport, ReportName, acFormatXLS, "C:\tempreport.xls", False
    '        DoCmd.OutputTo acOutputReport, ReportName, acFormatHTML, "C:\tempreport.html", False
    
            Dim EmailTo As String
                    
            'send mail to appropriate address
            If RecipientList = Parters Then
                EmailTo = Get_Email_for_Type("ReqPart")
            Else
                EmailTo = Get_Email_for_Type("ReqApp")
            End If
            
            If IsNull(EmailTo) Then
                SEND_EMAIL = False
            Else
                SEND_EMAIL = EMAIL_REPORT(EmailTo, message, Subject, "C:\tempreport.txt")
    '            SEND_EMAIL = EMAIL_REPORT(EmailTo, message, Subject, "C:\tempreport.xls")
     '           SEND_EMAIL = EMAIL_REPORT(EmailTo, message, Subject, "C:\tempreport.html")
    
            End If
                    
            'delete the file
            Kill ("C:\tempreport.txt")
            
            'call the close session sub to destroy the objects
            CLOSE_SESSION
        
        Else
            SEND_EMAIL = False
        End If
    
    End Function
    
    'unused, left for potential future use
    Private Function SEND_MULTIPLE_EMAILS(strSendTo() As String, strBody As String, strSubject As String, Optional strFile As String) As Boolean
        SEND_MULTIPLE_EMAILS = True
        Dim SendOne As Variant
        For Each SendOne In strSendTo
            SEND_MULTIPLE_EMAILS = SEND_MULTIPLE_EMAILS And _
                EMAIL_REPORT((SendOne), strBody, strSubject, strFile)
        Next
    End Function
    
    Private Function Get_Email_for_Type(strType As String) As String
        Get_Email_for_Type = DLookup("[Email]", "[NotifyEmails]", "[Type] = '" & strType & "' AND Active = -1")
    End Function
    
    Public Function OPEN_SESSION() As Boolean
    
    Dim objSession As Object
    Dim strServer As String
    Dim strMailFile As String
    
    'Outlook must be open for module to work correctly
    If MsgBox("Do you have Outlook running?", vbCritical + vbYesNo, "Warning!") = vbYes Then
    'this code must be left out of the loop so that only one session is started
    Set objSession = CreateObject("Notes.NOTESSESSION")
    
    strServer = objSession.GETENVIRONMENTSTRING("mailserver", True)
    strMailFile = objSession.GETENVIRONMENTSTRING("mailfile", True)
    
    Set mobjDB = objSession.GETDATABASE(strServer, strMailFile)
    
    OPEN_SESSION = True
    Else
    MsgBox "Please start Outlook and try again.", vbOKOnly, "Emails"
    OPEN_SESSION = False
    End If
    
    End Function
    
    Public Function EMAIL_REPORT(strSendTo As String, strBody As String, strSubject As String, Optional strFile As String) As Boolean
    On Error GoTo EmailReport_Err
    
    Dim objDoc As Object
    Dim objRichTextAttach As Object
    Dim objRichTextItem As Object
    Dim objAttachment As Object
    
    Const NOTES_RECIPIENTS = ""
    Const NOTES_REPORTS_USER = ""
    Const NOTES_MAIL_FILE = "C:\Email.txt"
    
    Set objDoc = mobjDB.CREATEDOCUMENT
    Set objRichTextAttach = objDoc.CREATERICHTEXTITEM("File")
    Set objRichTextItem = objDoc.CREATERICHTEXTITEM(objDoc, "Body")
    
    If strFile <> "" Then
    Set objAttachment = objRichTextAttach.EMBEDOBJECT(1454, "", strFile)
    End If
    
    'set up the email to be sent
    objRichTextItem.AppendText strBody
    objDoc.REPLACEITEMVALUE "SendTo", strSendTo
    objDoc.REPLACEITEMVALUE "Subject", strSubject
    
    objDoc.SaveMessageOnSend = True 'send E-mail
    objDoc.SEND False 'false for do not attach a form
    
    EMAIL_REPORT = True
    
    Exit_Here:
    Set objAttachment = Nothing
    Set objDoc = Nothing
    Set objRichTextAttach = Nothing
    Set objRichTextItem = Nothing
    Exit Function
    
    EmailReport_Err:
    EMAIL_REPORT = False
    Resume Exit_Here
    
    End Function
    
    Public Sub CLOSE_SESSION()
    
    Set mobjDB = Nothing
    
    End Sub
    

    Thursday, March 20, 2014 12:26 PM