VBA-Send email from Lotus Notes via another account

[george hart]

I have a spreadsheet which generates an automated email based on a condition - code below and works a treat. The email however is sent from my email address.

How do I get the automated email sent from another account? The reason I ask is because my team share an email account which I'd rather send the automated email from.

Any suggestions most appreciated...

Dim X As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim stSignature As String
Dim myDate As Date
myDate = Date
'MsgBox b - a

With Application
.ScreenUpdating = False
.DisplayAlerts = False
For X = 8 To Cells(Rows.Count, "B").End(xlUp).Row
Dim a As Date, b As Date
a = Worksheets("Reporting Period").Range("F" & X)
b = Date

If Worksheets("Reporting Period").Range("I" & X) = "" _
And Worksheets("Reporting Period").Range("H" & X) = "" _
And Worksheets("Reporting Period").Range("F" & X) <> "" _
And Worksheets("Reporting Period").Range("E" & X) <> "" _
And b - a >= 2 Then
' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
' Select range of e-mail addresses
Recipient = Array(Worksheets("Reporting Period").Range("E" & X) _
.Value)
ccRecipient = Array("Sean.Mcbroom@firstgroup.com", "Michael.Holmes@firstgroup.com", "Simon.Cassidy@firstgroup.com", "Steve.Tyler@firstgroup.com", "Claire.Mann@firstgroup.com", "David.Crome@firstgroup.com")
MailDoc.SendTo = Recipient
MailDoc.CopyTo = ccRecipient
MailDoc.Subject = "Passenger Charter Poster for Station " & Worksheets("Reporting Period").Range("B" & X).Value
MailDoc.body = "Please confirm by return that the Passenger Charter Poster for " & Worksheets("Reporting Period").Range("B" & X).Value _
& " is on display "
MailDoc.SAVEMESSAGEONSEND = True
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.send 0, Recipient

MsgBox "Notification sent to " & Worksheets("Reporting Period").Range("D" & X).Value & " Advising of reminder "
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
If Worksheets("Reporting Period").Range("I" & X).Value = "" Then Worksheets("Reporting Period").Range("I" & X).Value = Date
End If
Next X
End With
End Sub