问题
I am new here..
I am trying to find the solution to the following problem: I want to send emails through lotus notes to different recipients by using excel VBA and running a macro. For this, I have an object where I can select multiple recipients to whom I want to send an email and a code to match it with lotus notes accounts. It is actually working in the current worksheet (named Paulo) but I am not able to duplicate it in another worksheet (named Julia) using the exact same column and code. However, if I do so in another worksheet other than Julia it works so sometimes it does work.. it is odd!!
So far I have this:
-- Worksheet 3 (Paulo) --
Sub SendEmailUsingCOM()
'*******************************************************************************************
' Unlike OLE automation, one can use Early Binding while using COM
' To do so, replace the generic "object" by "commented" UDT
' Set reference to: Lotus Domino Objects
'*******************************************************************************************
Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String
'*******************************************************************************************
'To create notesession using COM objects, you can do so by using.
'either ProgID = Lotus.NotesSession
'or ClsID = {29131539-2EED-1069-BF5D-00DD011186B7}
'Replace ProgID by the commented string below.
'*******************************************************************************************
Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}
'*******************************************************************************************
'This part initializes the session and creates a new mail document
'*******************************************************************************************
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument
'*******************************************************************************************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'*******************************************************************************************
vToList = Application.Transpose(Range("S1").Resize(Range("S" & Rows.Count).End(xlUp).Row).Value)
vCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)
'*******************************************************************************************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'*******************************************************************************************
With nDoc
Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Validation Request")
With nAtt
.AppendText (Worksheets("Users").Range("M2").Value)
'Decide if you want to attach a file.
vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")
Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select
End With
Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)
End With
End Sub
General overview of Excel
-- Worksheet 8 (Julia) --
Sub SendEmailUsingCOM()
'*******************************************************************************************
' Unlike OLE automation, one can use Early Binding while using COM
' To do so, replace the generic "object" by "commented" UDT
' Set reference to: Lotus Domino Objects
'*******************************************************************************************
Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String
'*******************************************************************************************
'To create notesession using COM objects, you can do so by using.
'either ProgID = Lotus.NotesSession
'or ClsID = {29131539-2EED-1069-BF5D-00DD011186B7}
'Replace ProgID by the commented string below.
'*******************************************************************************************
Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}
'*******************************************************************************************
'This part initializes the session and creates a new mail document
'*******************************************************************************************
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument
'*******************************************************************************************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'*******************************************************************************************
vToList = Application.Transpose(Range("S1").Resize(Range("S" & Rows.Count).End(xlUp).Row).Value)
vCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)
'*******************************************************************************************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'*******************************************************************************************
With nDoc
Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Validation Request")
With nAtt
.AppendText (Worksheets("Users").Range("M2").Value)
'Decide if you want to attach a file.
vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")
Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select
End With
Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 11 Then
Target.Offset(0, 4).Value = Application.UserName
End If
If Not Intersect(Target, Range("K" & Rows.Count).End(xlUp)) Is Nothing Then
copyformulas
End If
End Sub
Private Sub Worksheet_Activate()
copyformulas
HideCollumnP
popup
End Sub
Sub copyformulas()
Dim Lastrow As Long
Lastrow = Range("K" & Rows.Count).End(xlUp).Row
lastRowj = Range("M" & Rows.Count).End(xlUp).Row
If Lastrow <> lastRowj Then
Range("M2:N2").AutoFill Destination:=Range("M2:N" & Lastrow)
Else
Exit Sub
End If
End Sub
Sub sbHidingUnHideRows()
'To Hide Rows 22 to 25
Rows("2").EntireRow.Hidden = False
End Sub
Sub HideCollumnP()
ActiveSheet.Columns("P").Hidden = True
ActiveSheet.Columns("W").Hidden = False
End Sub
Private Sub Catarina_Click()
If Catarina.Value = True Then ActiveSheet.Range("S2").Value = "catarina.silva@gmail.com"
If Catarina.Value = False Then ActiveSheet.Range("S2").Value = ""
End Sub
Sub popup()
ActiveSheet.Shapes.Range(Array("Group 19")).visible = False
End Sub
Sub ChoseVal()
ActiveSheet.Shapes.Range(Array("Group 19")).visible = True
End Sub
Please tell me how to solve this.
Thank you in advance!!
Hello! Thank you for your quick response.
To sum up the idea, first you open the given worksheet you fill in some data in cells and then you click the button and the userform window pops up and then you select the person to whom you want to send an email through Lotus notes.
I've done several changes in my excel file and so here's the situation: I copied the same vba code (below) and plus I created an ActiveX control CommandButton1 that is supposed to be assigned to a userform created with a checkbox list with names. Once you tick one of the boxes, an email will be sent through IBM lotus notes. A popup window (userform) should appear on button click.
Problem: It does not send the email only the first worksheet (original one) does send it.
(1) Visual Basic Editor - Sheet 1
Sub SendEmailUsingCOM()
'*******************************************************************************************
' Unlike OLE automation, one can use Early Binding while using COM
' To do so, replace the generic "object" by "commented" UDT
' Set reference to: Lotus Domino Objects
'*******************************************************************************************
Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String
'*******************************************************************************************
'To create notesession using COM objects, you can do so by using.
'either ProgID = Lotus.NotesSession
'or ClsID = {29131539-2EED-1069-BF5D-00DD011186B7}
'Replace ProgID by the commented string below.
'*******************************************************************************************
Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}
'*******************************************************************************************
'This part initializes the session and creates a new mail document
'*******************************************************************************************
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument
'*******************************************************************************************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'*******************************************************************************************
vToList = Application.Transpose(Range("W1").Resize(Range("W" & Rows.Count).End(xlUp).Row).Value)
vCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)
'*******************************************************************************************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'*******************************************************************************************
With nDoc
Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Validation Request")
With nAtt
.AppendText (Worksheets("Users").Range("A2").Value)
'Decide if you want to attach a file.
vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")
Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select
End With
Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)
End With
End Sub
Plus the button to enable the userform and select emails in cells of column W...
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Private Sub AliceCorreia_Click()
If Alice.Value = True Then ActiveSheet.Range("W2").Value = "alice2002@hotmail.com"
If Alice.Value = False Then ActiveSheet.Range("W2").Value = ""
End Sub
(2) VBA Editor - Forms - Userform1 13 names (e.g. Checkbox 1 Alice Correia, etc.) this code is intended to uncheck all checkboxes.
Private Sub Userform1_Initialize()
CheckBox1.Value = False
CheckBox2.Value = False
CheckBox3.Value = False
CheckBox4.Value = False
CheckBox5.Value = False
CheckBox6.Value = False
CheckBox7.Value = False
CheckBox8.Value = False
CheckBox9.Value = False
CheckBox10.Value = False
CheckBox11.Value = False
CheckBox12.Value = False
CheckBox13.Value = False
End Sub
I hope it is clear now and thank you so much for your help!! Have a good day!
来源：https://stackoverflow.com/questions/37345413/sending-email-through-lotus-notes-using-excel-vba