Question

当您点击它时，有一个命令按钮作为向客户发送电子邮件的触发器。它将首先调用该函数：

Private Sub Lotus2_Click()
ThisWorkbook.Send_Unformatted_Rangedata (2)
End Sub

然后有两个部分用于另一个等待调用的工作表中的函数，我无法调试它，因为每当我想要时，系统只显示调用该函数的行。问题是我知道调用函数有什么不对，但我不确定函数的哪个部分出错了。对不起，因为功能部分有点单调乏味，如下所示。对于任何给出的建议，我将非常感激，谢谢。

********* UPDATE ******************* 嗨，我刚发现此行有问题，错误消息为Run time error -2147417851 (80010105) Automation error The server threw an exception：

Set noDocument = noDatabase.CreateDocument

但我没有看到任何错误。任何帮助将不胜感激。

Sub Send_Unformatted_Rangedata(i As Integer)
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim vaRecipient As Variant
Dim rnBody As Range
Dim Data As DataObject
Dim rngGen As Range
Dim rngApp As Range
Dim rngspc As Range

Dim stSubject As String
stSubject = "E-Mail For Approval for " + (Sheets("Summary").Cells(i, "A").Value) + "  for the Project  " + Replace(ActiveWorkbook.Name, ".xls", "")
'Const stMsg As String = "Data as part of the e-mail's body."
'Const stPrompt As String = "Please select the range:"

'This is one technique to send an e-mail to many recipients but for larger
'number of recipients it's more convenient to read the recipient-list from
'a range in the workbook.
 vaRecipient = VBA.Array(Sheets("Summary").Cells(i, "U").Value, Sheets("Summary").Cells(i, "V").Value)

On Error Resume Next
'Set rnBody = Application.InputBox(Prompt:=stPrompt, _
     Default:=Selection.Address, Type:=8)
'The user canceled the operation.
'If rnBody Is Nothing Then Exit Sub
Set rngGen = Nothing
Set rngApp = Nothing
Set rngspc = Nothing

Set rngGen = Sheets("General Overview").Range("A1:C30").SpecialCells(xlCellTypeVisible)
Set rngApp = Sheets("Application").Range("A1:E13").SpecialCells(xlCellTypeVisible)

Set rngspc = Sheets(Sheets("Summary").Cells(i, "P").Value).Range(Sheets("Summary").Cells(i, "Q").Value).SpecialCells(xlCellTypeVisible)
Set rngspc = Union(rngspc, Sheets(Sheets("Summary").Cells(i, "P").Value).Range(Sheets("Summary").Cells(i, "R").Value).SpecialCells(xlCellTypeVisible))

 On Error GoTo 0

If rngGen Is Nothing And rngApp Is Nothing And rngspc Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If


'Instantiate Lotus Notes COM's objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

'Make sure Lotus Notes is open and available.
 If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

'Create the document for the e-mail.
Set noDocument = noDatabase.CreateDocument

'Copy the selected range into memory.
rngGen.Copy
rngApp.Copy
rngspc.Copy

'Retrieve the data from then copied range.
Set Data = New DataObject
Data.GetFromClipboard

'Add data to the mainproperties of the e-mail's document.
With noDocument
  .Form = "Memo"
  .SendTo = vaRecipient
  .Subject = stSubject
  'Retrieve the data from the clipboard.
  .Body = Data.GetText & " " & stMsg
  .SaveMessageOnSend = True
End With

'Send the e-mail.
With noDocument
  .PostedDate = Now()
  .send 0, vaRecipient
End With

'Release objects from memory.
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing


'Activate Excel for the user.
AppActivate "Microsoft Excel"

'Empty the clipboard.
Application.CutCopyMode = False

MsgBox "The e-mail has successfully been created and distributed.", vbInformation

End Sub

Answer 1

然后在另一张表中有两部分用于该功能

如果程序位于工作表模块中，则应使用以下命令调用它们：

Sheet_Object_Name.Send_Unformatted_Rangedata (2)

第二个选项是将程序移至ThisWorkbook模块和您的代码：

ThisWorkbook.Send_Unformatted_Rangedata (2)

应该可以正常工作。

另一种解决方案是在项目中添加一个单独的模块（使用Insert->Module），在那里移动程序，然后您可以使用其他模块调用这些程序：

Send_Unformatted_Rangedata (2)

在excel vba中调用函数时无效的过程调用或参数

1 个答案: