使用 Excel VBA 通过 Lotus Notes 发送电子邮件

我刚来这地方..

我正在尝试找到以下问题的解决方案：我想通过使用 Excel VBA 并运行宏通过 Lotus Notes 将电子邮件发送给其他收件人。为此，我有一个对象，可以在其中选择多个要向其发送电子邮件的收件人，并选择一个与 Lotus Notes 帐户匹配的代码。它实际上在当前工作表(名为 Paulo)中工作，但是我无法使用完全相同的列和代码在另一个工作表(名为 Julia)中复制它。但是，如果我在 Julia 以外的其他工作表中这样做，它有时会起作用，..这很奇怪！

到目前为止，我有这个：

-工作表 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

Excel 的概述

-工作表 8(朱莉娅)-

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

请告诉我如何解决这个问题。

先感谢您！！

你好！感谢你的快速回复。

总结一下想法，首先打开给定的工作表，在单元格中填写一些数据，然后单击按钮，弹出用户窗体窗口，然后选择要通过 Lotus Notes 向其发送电子邮件的人。

我已经在 excel 文件中做了几处更改，因此是这种情况：复制了相同的 vba 代码(如下)，并且我创建了 ActiveX 控件 CommandButton1，该控件应该分配给使用名称复选框创建的用户窗体。选中其中一个框后，将通过 IBM Lotus Notes 发送电子邮件。单击按钮后，将出现一个弹出窗口(用户窗体)。

问题：仅第一个工作表(原始工作表)发送电子邮件，它不会发送电子邮件。

(1)Visual Basic 编辑器-工作表 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

加上按钮以启用用户窗体并在 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 编辑器-表单-Userform1 13 个名称(e.g. 复选框 1 Alice Correia，etc.)此代码用于取消选中所有复选框。

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

我希望现在已经很清楚了，非常感谢您的帮助！祝你有美好的一天！