使用excel VBA

Question

我是新来的..

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

到目前为止，我有这个：

- 工作表3（保罗） -

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

- 工作表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向其发送电子邮件的人员笔记。

我在excel文件中做了几处更改，所以情况如下：我复制了相同的vba代码（下面）并且我创建了一个ActiveX控件CommandButton1，它应该分配给一个使用带名称的复选框列表创建的userform。勾选其中一个框后，将通过IBM Lotus Notes发送一封电子邮件。按钮单击时应出现一个弹出窗口（userform）。

问题：它不会仅发送第一个工作表（原始工作表）发送的电子邮件。

（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个名称（例如Checkbox 1 Alice Correia等）此代码旨在取消选中所有复选框。

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

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