VBA Code Help

[chrissmarlow]

Hi,

I found the below code for saving and sending a worksheet through Lotus notes. I really like the code however, there are a couple of tweaks I would like to make to it but I dont know how to, can anyone help?

Sub SendWithLotus()
    Dim noSession As Object, noDatabase As Object, noDocument As Object
    Dim obAttachment As Object, EmbedObject As Object
    Dim stSubject As Variant, stAttachment As String
    Dim vaRecipient As Variant, vaMsg As Variant
 
    Const EMBED_ATTACHMENT As Long = 1454
    Const stTitle As String = "Active workbook status"
    Const stMsg As String = "The active workbook must first be saved " & vbCrLf _
    & "before it can be sent as an attachment."
     'Check if the active workbook is saved or not
     'If the active workbook has not been saved at all.
    If Len(ActiveWorkbook.Path) = 0 Then
        MsgBox stMsg, vbInformation, stTitle
        Exit Sub
    End If
     'If the changes in the active workbook have been saved or not.
    If ActiveWorkbook.Saved = False Then
        If MsgBox("Do you want to save the changes before sending?", _
        vbYesNo + vbInformation, stTitle) = vbYes Then _
        ActiveWorkbook.Save
    End If
     'Get the name of the recipient from the user.
    Do
        vaRecipient = Application.InputBox( _
        Prompt:="Please add name of the recipient:", _
        Title:="Recipient", Type:=2)
    Loop While vaRecipient = ""
     'If the user has canceled the operation.
    If vaRecipient = False Then Exit Sub
     'Get the message from the user.
    Do
        vaMsg = Application.InputBox( _
        Prompt:="Please enter the message body:", _
        Title:="Message", Type:=2)
    Loop While vaMsg = ""
 
     'If the user has canceled the operation.
    If vaMsg = False Then Exit Sub
     'Add the subject to the outgoing e-mail
     'which also can be retrieved from the users
     'in a similar way as above.
    Do
        stSubject = Application.InputBox( _
        Prompt:="Please add a subject", _
        Title:="Subject", Type:=2)
    Loop While stSubject = ""
     'Retrieve the path and filename of the active workbook.
    stAttachment = ActiveWorkbook.FullName
     'Instantiate the Lotus Notes COM's Objects.
    Set noSession = CreateObject("Notes.NotesSession")
    Set noDatabase = noSession.GETDATABASE("", "")
     'If Lotus Notes is not open then open the mail-part of it.
    If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
     'Create the e-mail and the attachment.
    Set noDocument = noDatabase.CreateDocument
    Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
    Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
     'Add values to the created e-mail main properties.
    With noDocument
        .Form = "Memo"
        .SendTo = vaRecipient
        .Subject = stSubject
        .Body = vaMsg
        .SaveMessageOnSend = True
    End With
     'Send the e-mail.
    With noDocument
        .PostedDate = Now()
        .Send 0, vaRecipient
    End With
 
     'Release objects from the memory.
    Set EmbedObject = Nothing
    Set obAttachment = Nothing
    Set noDocument = Nothing
    Set noDatabase = Nothing
    Set noSession = Nothing
 
     'Activate Excel for the user.
    AppActivate "Microsoft Excel"
    MsgBox "The E-Mail has been sent", vbInformation
End Sub

The code, when run, asks the user for the email address of the recipient. What I really would like it to do is look for populated cells in column I and send it to those recipients (as column I contains email addresses) is this possible?

Thanks in advance for your help!

 

[Andrew Poulsom]

Have you tried passing a variant array to the SendTo property? This may help you:

http://www.mrexcel.com/forum/showthread.php?t=352769

 

[chrissmarlow]

Have you tried passing a variant array to the SendTo property? This may help you:

http://www.mrexcel.com/forum/showthread.php?t=352769

I havn't but my VBA skills are VERY basic, maybe I pushed myself too far this time! I will have another look through that thread and see if I can work it out. Thanks

 

[chrissmarlow]

Im still very confused with how to do this. In column I of my spreadssheet I have email addresses of the proposed recipientst of the email, there are however a lot of blanks, what I want to do is send it to the email addresses in the cells in column I and ignore blanks, can someone tell me how to incorporate this into the above code? Thanks again.

 

[Andrew Poulsom]

To crete a variant array from the nonblank cells in column I?

Sub Test()
    Dim SendTo() As Variant
    Dim i As Long
    Dim Cell As Range
    With Columns("I")
        For Each Cell In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
            If Not IsEmpty(Cell) Then
                i = i + 1
                ReDim Preserve SendTo(1 To i)
                SendTo(i) = Cell.Value
            End If
        Next Cell
    End With
End Sub