Converting VBA language referencing LotusNotes to language referencing Outlook

Hello. I need some help from some VBA experts.

Ideally what I'm trying to do is replace the commands for LotusNotes with commands for Outlook. For privacy reasons, I've redacted some of the indentifiable information, namely the email address to which the test email would be sent and the file path where the files are found.

I don't know if what I'm attempting to do is possible as everything I've read says the conversion from LotusNotes to Outlook is complicated, and I'm pretty novice, but any help you can provide will be very appreciated.



Thanks!

----------------------------------------------------------------------------------------------------------------------

Function ComposeEmailInLotusNotes(Optional ByVal SendToArray As Variant, _
Optional ByVal Subject As Variant, _
Optional ByVal PathToBody As Variant, _
Optional ByVal PathToDisclaimer As Variant, _
Optional ByVal CopyToArray As Variant, _
Optional ByVal BlindCopyToArray As Variant, _
Optional ByVal AttachmentFileArray As Variant) As Boolean

'On Error GoTo ErrHandler

Dim I As Long
Dim Msg As String
Dim Session As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim EmbedObj As Object
Dim Workspace As Object
Dim UIDoc As Object
Dim WordApp As Object, WordDoc As Object
Dim BodyMarker As String, DiscMarker As String

'Create a Lotus Notes Session
Set Session = CreateObject("Notes.NotesSession")

'Get the Lotus Notes UserName
UserName = Session.UserName

'Construct the MailDbName from the UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set MailDb = Session.GETDATABASE("", MailDbName)

'If Lotus Notes is not already open, open it
If MailDb.IsOpen = False Then
MailDb.OPENMAIL
End If

'Create New Email
Set MailDoc = MailDb.CREATEDOCUMENT
MailDoc.Form = "Memo"
If Len(PathToBody) > 0 Then BodyMarker = "Body_Goes_Here"
If Len(PathToDisclaimer) > 0 Then
DiscMarker = "Disc_Sig_Go_Here"
Else
MsgBox "File Containing Disclaimer Message not Selected. Please Select File and Retry.", vbOKOnly + vbCritical, "Warning!"
GoTo ErrHandler
End If

'Populate the recipients
If Not VBA.IsMissing(SendToArray) Then MailDoc.SendTo = SendToArray
If Not VBA.IsMissing(CopyToArray) Then MailDoc.CopyTo = CopyToArray
If Not VBA.IsMissing(BlindCopyToArray) Then MailDoc.BlindCopyTo = BlindCopyToArray

'Populate the Subject & Body of the Email
If Not VBA.IsMissing(Subject) Then MailDoc.Subject = Subject
If Not VBA.IsMissing(PathToBody) Then MailDoc.Body = BodyMarker & vbCrLf & vbCrLf & DiscMarker Else MailDoc.Body = DiscMarker
MailDoc.Save True, False

'Add attachments, if any
If Not VBA.IsMissing(AttachmentFileArray) Then
If Not VBA.IsArray(AttachmentFileArray) Then
Call MsgBox("Attachments must be passed as an array.", vbExclamation, "Error")
Else
For I = LBound(AttachmentFileArray) To UBound(AttachmentFileArray)
If FileFolderExists(CStr(AttachmentFileArray(I))) Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment" & I)
'1454 indicates a file attachment
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "Attachment" & I, AttachmentFileArray(I), "") 'Required File Name
Else
Call MsgBox("Attachment file does not exist at: " & AttachmentFileArray(I) & ". Press OK to continue.", vbExclamation, "Error")
End If
Next I
End If
End If

'Specify that the email should be saved to the Database
'Specify the posted date, otherwise the email will not get saved
MailDoc.PostedDate = Now()
MailDoc.SAVEMESSAGEONSEND = True

'Create a Worksapce to hold the email
Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Set UIDoc = Workspace.EDITDOCUMENT(True, MailDoc)

With UIDoc
'Find The Marker Text in the Body Item
.GOTOFIELD ("Body")

Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False

If Len(PathToBody) > 0 Then
.FINDSTRING BodyMarker
'Open the Word document containing Body Text
Set WordDoc = WordApp.Documents.Open(PathToBody)
'Copy all contents to clipboard
With WordApp.Selection
.WholeStory
.Copy
End With
'Paste Body into the Email
.Paste
WordDoc.Close SaveChanges:=False
Set WordDoc = Nothing
End If

.FINDSTRING DiscMarker
'Open the Disclaimer Signature Word document
Set WordDoc = WordApp.Documents.Open(PathToDisclaimer)
'Copy all contents to clipboard
With WordApp.Selection
.WholeStory
.Copy
End With
'Paste Disclaimer into Email
.Paste
Application.CutCopyMode = False
WordApp.Quit SaveChanges:=False
Set WordApp = Nothing
Set WordDoc = Nothing

End With

'Varun's Historical Code - Similar to above
' 'Open the Workspace and put the cursor in the Body of the email
' Call Workspace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")
' Call Workspace.RELOADWINDOW

'Exit function successfully
Set Session = Nothing
Set MailDb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set EmbedObj = Nothing
Set Workspace = Nothing

On Error GoTo 0

ComposeEmailInLotusNotes = True

Exit Function

ErrHandler:

Msg = "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext

Set Session = Nothing
Set MailDb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set EmbedObj = Nothing
Set Workspace = Nothing

ComposeEmailInLotusNotes = False

On Error GoTo 0

End Function

____________________________________________________________________________________________________________________________

Sub avtest()

Dim attachment As Variant

ReDim attachment(1)
attachment(1) = "C:\Users\XXXXXX\Desktop\Test Attachment.pdf"
Call ComposeEmailInLotusNotes(SendToArray:="[email protected]", Subject:="Test", _
PathToBody:="C:\Users\XXXXXX\Desktop\TestBody.docx", PathToDisclaimer:="C:\Users\XXXXXX\Desktop\DiscSig.docx", _
CopyToArray:="[email protected]", BlindCopyToArray:="[email protected]", AttachmentFileArray:=attachment)


End Sub