Excel V5.0 to Lotus Notes 4.5
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 4 of 4

Thread: Excel V5.0 to Lotus Notes 4.5

  1. #1
    New Member DaveSwanton77's Avatar
    Join Date
    Apr 2002
    Location
    Bolton, Lancs
    Posts
    39
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    I have written a procedure in excel that produces reports and then save them in separate files. Is there any way I could create a lotus notes e-mail and send them from Excel?

  2. #2
    Board Regular
    Join Date
    Feb 2002
    Location
    Southfield,MI USA
    Posts
    2,305
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    I 2nd that request,

    I used to have a co-worker that claimed he managed to do this (so I guess it's possible anyway). I've never been able to scrounge that code from him though - and I haven't been able to figure it out myself (I'm still on the beginner end of the VBA spectrum).

    Please post if you're a Lotus Notes user who has tried to do this.

    Adam

  3. #3
    MrExcel MVP Jay Petrulis's Avatar
    Join Date
    Mar 2002
    Location
    Chicago, IL USA
    Posts
    2,040
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Here is the code that I use. I had to change a few things before I could post it, so please report back any problems.

    Put the Declare Function statement at the top of the module, after the Option Explicit (if used) and before any other routines.

    The code will prompt you to enter the e-mail addresses of the recipients, separated by a comma, although that can be changed to looping through a list on a worksheet, for example.

    I have this set up to send to up to 14-15 recipients (including groups). I originally had the code read the mailing list into an array, but the "mail to" wouldn't read the whole array correctly, so I forced it into an If-Then-Else structure.

    Note, this code saves the workbook with a concatenation of three cells on the sheet (active sheet I believe, as my program copies one sheet from a file to a new workbook). Please change that to suit your requirements (where I set strfilename to the value of 3 cells in the sheet).

    Finally, the workbook also mails to the user's login name. If you are not on a network, then be careful there, although I don't know any people who have Lotus Notes on their home computer.

    ------------------------------
    Private Declare Function apiGetUserName Lib "advapi32.dll" _
    Alias "GetUserNameA" (ByVal lpBuffer As String, nsize As Long) As Long


    Private Sub mail_report()
    Dim strfilename As String
    Dim mail_list As String, x As Integer
    Dim Position() As Integer
    Dim NameList() As String
    Dim strNameCt As Integer

    ' be sure to reference the Lotus Domino Objects, domobj.tlb
    Dim objNotesSession As Object
    Dim objNotesDatabase As Object
    Dim objNotesDocument As Object
    Dim objAttachment As Object
    Dim objRichText As Object
    Dim FullPath As String
    Dim FileName As String
    Dim Msg As String

    Const EMBED_ATTACHMENT = 1454

    Set objNotesSession = CreateObject("Notes.Notessession")
    Set objNotesDatabase = objNotesSession.GetDatabase("", "")
    Call objNotesDatabase.OpenMail 'default mail database
    If objNotesDatabase.IsOpen = False Then
    MsgBox "Cannot connect to Lotus Notes."
    Exit Sub
    End If
    Set objNotesDocument = objNotesDatabase.CreateDocument
    Call objNotesDocument.ReplaceItemValue("Form", "Memo")

    mail_list = Application.InputBox("Enter the e-mail address of your" & vbCr & "recipient(s)." & vbCr & vbCr & "For multiple recipients, please separate" & vbCr & "the e-mail addresses with a comma.", "Send file")
    If IsEmpty(mail_list) Then Exit Sub
    If mail_list = "" Then Exit Sub
    If mail_list = "False" Then Exit Sub
    Msg = Application.InputBox("Enter a brief message (not required)" & vbCr & "to be added to the message text.", "Add a cheerful greeting!")
    If Msg = "False" Then Msg = ""
    strNameCt = Len(mail_list) - Len(WorksheetFunction.Substitute(mail_list, ",", "")) + 1

    Application.ScreenUpdating = False
    ChDrive "C"
    ChDir "C:Excel"

    If strNameCt = 1 Then GoTo Send_The_File

    ReDim Position(1 To strNameCt - 1)
    For x = 1 To strNameCt - 1
    If x = 1 Then
    Position(x) = WorksheetFunction.Search(",", mail_list, 1)
    Else
    Position(x) = WorksheetFunction.Search(",", mail_list, Position(x - 1) + 1)
    End If
    Next x
    ReDim NameList(1 To strNameCt)
    For x = 1 To strNameCt
    If x = 1 Then
    NameList(x) = Left(mail_list, Position(x) - 1)
    ElseIf x = strNameCt Then
    NameList(x) = Right(mail_list, Len(mail_list) - Position(x - 1) - 1)
    Else
    NameList(x) = Mid(mail_list, Position(x - 1) + 1, Position(x) - Position(x - 1) - 1)
    End If
    Next x

    Send_The_File:
    Application.DisplayAlerts = False
    With ActiveWorkbook
    Range("A1").Select
    strfilename = Cells(1, 3) & " " & Cells(2, 3) & " " & Cells(3, 3).Text
    .SaveAs FileName:=strfilename
    End With
    Application.DisplayAlerts = True
    ' assemble message
    Set objRichText = objNotesDocument.CreateRichTextItem("Body")
    Set objAttachment = objRichText.EmbedObject(EMBED_ATTACHMENT, "", ActiveWorkbook.FullName, strfilename)
    Msg = Msg & vbCr & vbCr & "Report sent by " & objNotesSession.CommonUserName
    With objNotesDocument
    .Subject = strfilename
    .Body = Msg
    If strNameCt = 1 Then
    .SendTo = Array(mail_list, fOSUserName)
    ElseIf strNameCt = 2 Then
    .SendTo = Array(NameList(1), NameList(2), fOSUserName)
    ElseIf strNameCt = 3 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), fOSUserName)
    ElseIf strNameCt = 4 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), fOSUserName)
    ElseIf strNameCt = 5 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), NameList(5), fOSUserName)
    ElseIf strNameCt = 6 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), NameList(5), NameList(6), fOSUserName)
    ElseIf strNameCt = 7 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), NameList(5), NameList(6), NameList(7), fOSUserName)
    ElseIf strNameCt = 8 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), NameList(5), NameList(6), NameList(7), NameList(8), fOSUserName)
    ElseIf strNameCt = 9 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), NameList(5), NameList(6), NameList(7), NameList(8), NameList(9), fOSUserName)
    ElseIf strNameCt = 10 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), NameList(5), NameList(6), NameList(7), NameList(8), NameList(9), NameList(10), fOSUserName)
    ElseIf strNameCt = 11 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), NameList(5), NameList(6), NameList(7), NameList(8), NameList(9), NameList(10), NameList(11), fOSUserName)
    ElseIf strNameCt = 12 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), _
    NameList(5), NameList(6), NameList(7), NameList(8), NameList(9), _
    NameList(10), NameList(11), NameList(12), fOSUserName)
    ElseIf strNameCt = 13 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), _
    NameList(5), NameList(6), NameList(7), NameList(8), NameList(9), _
    NameList(10), NameList(11), NameList(12), NameList(13), fOSUserName)
    ElseIf strNameCt = 14 Then
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), _
    NameList(5), NameList(6), NameList(7), NameList(8), NameList(9), _
    NameList(10), NameList(11), NameList(12), NameList(13), NameList(14), fOSUserName)
    Else
    .SendTo = Array(NameList(1), NameList(2), NameList(3), NameList(4), _
    NameList(5), NameList(6), NameList(7), NameList(8), NameList(9), _
    NameList(10), NameList(11), NameList(12), NameList(13), NameList(14), _
    NameList(15), fOSUserName)
    End If
    .SaveMessageOnSend = True ' save in Sent folder
    .Send (False)
    End With
    ActiveWorkbook.Close
    End Sub

    Function fOSUserName() As String
    ' Returns the network login name
    Dim lngLen As Long, lngX As Long
    Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngX = apiGetUserName(strUserName, lngLen)
    If lngX <> 0 Then
    fOSUserName = Left$(strUserName, lngLen - 1)
    Else
    fOSUserName = ""
    End If
    End Function
    -----------------------

    Bye,
    Jay

  4. #4
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Christchurch New Zealand
    Posts
    1,030
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    Good for sending attachments Jays post is better for sending to multi ppl .


    'Need to set reference to Lotus Notes as well , Tools References
    Private Sub SendNotesMail()
    Dim Maildb As Object
    Dim UserName As String
    Dim MailDbName As String
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim EmbedObj1 As Object
    Dim EmbedObj2 As Object
    Dim EmbedObj4 As Object
    Dim EmbedObj5 As Object
    Dim EmbedObj6 As Object
    Dim EmbedObj7 As Object
    Dim EmbedObj8 As Object
    Dim EmbedObj9 As Object
    Dim EmbedObj10 As Object
    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
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    Recipient = mailname 'Range("a15").Value
    MailDoc.sendto = Recipient
    ccRecipient = Range("a16").Value
    MailDoc.CopyTo = ccRecipient
    bccRecipient = Range("a17").Value
    MailDoc.BlindCopyTo = bccRecipient
    Subject = "Your Text"
    MailDoc.Subject = Subject
    BodyText = "Your Text in "
    MailDoc.Body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    ' Attachments and Range they have to be in
    Attachment1 = Range("d15")
    If Attachment1 <> "" Then
    On Error Resume Next
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
    On Error Resume Next
    Set EmbedObj1 = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment")
    On Error Resume Next
    MailDoc.CREATERICHTEXTITEM ("Attachment")
    On Error Resume Next
    End If

    MailDoc.PostedDate = Now()
    On Error GoTo errorhandler1
    MailDoc.SEND 0, Recipient
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj1 = Nothing
    Set EmbedObj2 = Nothing
    Set EmbedObj3 = Nothing
    Set EmbedObj4 = Nothing
    Set EmbedObj5 = Nothing
    Set EmbedObj6 = Nothing
    Set EmbedObj7 = Nothing
    Set EmbedObj8 = Nothing
    Set EmbedObj9 = Nothing
    Set EmbedObj10 = Nothing
    Exit Sub
    errorhandler1:
    On Error Resume Next

    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj1 = Nothing
    Set EmbedObj2 = Nothing
    Set EmbedObj3 = Nothing
    Set EmbedObj4 = Nothing
    Set EmbedObj5 = Nothing
    Set EmbedObj6 = Nothing
    Set EmbedObj7 = Nothing
    Set EmbedObj8 = Nothing
    Set EmbedObj9 = Nothing
    Set EmbedObj10 = Nothing
    End Sub

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com