Question

我是编码的初学者，因此，我希望在此问题上有所帮助：我有一个excel工作表，当按下按钮时，用户也会输入人员数据（姓名，电子邮件地址，手机号码，服务提供，约会日期，约会类型，约会时间）作为约会，都将发送给会员。使用下面的代码，我无法从Excel工作表中将会员电子邮件地址或约会日期和时间拖到Outlook约会中。

Sub Button2test_Click()
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
     On Error Resume Next
    ' Only send the visible cells in the selection.
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set rng = 
    Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, 
    xlTextValues)
    On Error GoTo 0

    If rng 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

    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
    .To = Range("$F$2")
    .CC = Range("$B$2")
    .BCC = ""
    .Subject = "Upcoming Scheduled Appointment"
    .HTMLBody = Range("$K$2")
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    .Display
    End With
    On Error GoTo 0

    With Application
    .EnableEvents = True
    .ScreenUpdating = True
     End With

     Set OutMail = Nothing
     Set OutApp = Nothing


    Set rng = Nothing
    On Error Resume Next
    ' Only send the visible cells in the selection.
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set rng = 
    Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, 
     xlTextValues)
    On Error GoTo 0

    If rng 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

    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olAppointmentItem)
    OutMail.MeetingStatus = olMeeting

    On Error Resume Next
    With OutMail
    .To = Range("$F$2")
    .Subject = Range("I2")
    .Location = Range("I2")
    .Importance = True
    .Start = Range("J2") & Format(Date + "H2")
    .End = Range("J2") & Format(Time + 0)
    .ReminderMinutesBeforeStart = 30
    .Body = Range("K2")
    .Display
    End With


    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With

   Set OutMail = Nothing
   Set OutApp = Nothing
End Sub

Answer 1

很难猜测您的代码正在尝试做什么。这里有几点可帮助您入门。

像这样On Error Resume Next的意思是“不要因为我喜欢神秘的故障而告诉我任何错误。目前，只需删除所有On Error条语句即可。

您的某些代码处理了显式单元格：D4：D12，F2，B2，K2和I2。其他代码处理选择中的可见单元格。对我来说，混合两种寻址单元的技术对我没有意义。

您将Set rng = Nothing降低到Set OutApp = Nothing，然后又有了相同的代码块，但有附加内容。您需要确定所需的代码块。

您认为此声明的作用是什么？

Set rng = 
Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, 
xlTextValues)

除非将要继续的各行末尾都带有下划线，否则您不能在多行中声明。即使从句法上讲是正确的，我也看不出该语句与宏的其余部分有何关系。

K2细胞真的是一个Html身体吗？我怀疑这是文字。

几年前我退休了，所以我对约会的记忆消失了。我的回忆是，我们发送了邀请，接收者通过接受邀请将其转变为约会。即使这些是例行的团队会议或类似的会议，您也需要与会者接受或拒绝邀请，因为您想知道谁会来。

Answer 2

我已经更新了会议部分，因为在与会议的必需与会者和可选与会者进行交流时没有To字段。

Sub Button2test_Click()
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
     On Error Resume Next
    ' Only send the visible cells in the selection.
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set rng = 
    Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, 
    xlTextValues)
    On Error GoTo 0

    If rng 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

    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
    .To = Range("$F$2")
    .CC = Range("$B$2")
    .BCC = ""
    .Subject = "Upcoming Scheduled Appointment"
    .HTMLBody = Range("$K$2")
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    .Display
    End With
    On Error GoTo 0

    With Application
    .EnableEvents = True
    .ScreenUpdating = True
     End With

     Set OutMail = Nothing
     Set OutApp = Nothing


    Set rng = Nothing
    On Error Resume Next
    ' Only send the visible cells in the selection.
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set rng = Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, 
     xlTextValues)
    On Error GoTo 0

    If rng 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

    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olAppointmentItem)
    OutMail.MeetingStatus = olMeeting

    On Error Resume Next
    With OutMail
    .requiredattendees  = Range("$F$2")
    .Subject = Range("I2")
    .Location = Range("I2")
    .Start = Range("J2") & Format(Date + "H2")'Format should be DD/MM/YYY(or as per your local settings) HH:MM:SS AM/PM(example 13/12/2020 08:30:00 PM)
    .End = Range("J2") & Format(Time + 0)'Format should be DD/MM/YYY(or as per your local settings) HH:MM:SS AM/PM(example 13/12/2020 08:30:00 PM)
    .ReminderMinutesBeforeStart = 30
    .Body = Range("K2")
    .Display
    End With


    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With

   Set OutMail = Nothing
   Set OutApp = Nothing
End Sub

使用VBA在Outlook中设置约会

2 个答案: