Auto Email from excel using a Global Email Address

using code that I got off this site I have figured out how to send out an email using lotus notes with excel.  (code is listed below)  My problem now is that I need to change the name of the sender to a Global address.  Is this possible or dose the sender have to be the person that is currently logged into Lotus notes?


Sub SendEMail()

    Application.DisplayAlerts = False
   
    Dim ws As Object, uiDoc As Object, session As Object, db As Object, uidb As Object, NotesAttach As Object, NotesDoc As Object
    Dim server, MailFile, user, usersig As String
    Dim SheetName As String, ExcelRange As String, EmailSubject As String, bodyMsg As String
    Dim noteid As String

    Workbooks("Test SL Update.xls").Activate
   
    SheetName = "Sheet1"
    ExcelRange = Range("A1").Activate
    EmailSubject = " Service Level Update " & Time & " " & Date
   
    Set ws = CreateObject("Notes.NotesUIWorkspace")
    Set session = CreateObject("Notes.NotesSession")
   
    user = session.UserName
    usersig = session.COMMONUSERNAME
    server = session.GetEnvironmentString("MailServer", True)
    MailFile = session.GetEnvironmentString("MailFile", True)
   
    Set db = session.GETDATABASE(server, MailFile)
    Set uidb = ws.CurrentDatabase
    Set NotesDoc = db.CreateDocument
   
    NotesDoc.Subject = EmailSubject
    NotesDoc.SendTo = "Jesse_Terrell@toyota.com; Drew_Winner@Toyota.com"
           
    Sheets(SheetName).Select
    Sheets(SheetName).Range("B6:C66").Select
    Selection.Copy
   
    Dim noWord As Object, myDoc As Object
    Set noWord = CreateObject("Word.Application")
    noWord.Visible = False
    noWord.Documents.Add
    Set myDoc = noWord.ActiveDocument
   
    noWord.Selection.Paste
    myDoc.Tables(1).AutoFitBehavior (wdAutoFitContent) ' wdAutoFitWindow

    Application.CutCopyMode = False

    Set myDoc = noWord.ActiveDocument
    myDoc.Tables(1).Range.Copy
   
    Set uiDoc = ws.EDITDOCUMENT(True, NotesDoc)
    Call uiDoc.GOTOFIELD("Body")
    Call uiDoc.FIELDAPPENDTEXT("Body", bodyMsg & Chr$(13))
    Call uiDoc.Paste
    Call uiDoc.Send
    Call uiDoc.Close
   
    noWord.Application.Quit (0)
    Set session = Nothing
    Set db = Nothing
    Set NotesAttach = Nothing
    Set NotesDoc = Nothing
    Set uiDoc = Nothing
    Set ws = Nothing
    Set noWord = Nothing
       
    AppActivate "Microsoft Excel"
    Application.CutCopyMode = False

    MsgBox "E-mail has been sent !", vbInformation
       
End Sub
Start Free Trial