复制文字

Question

我正在使用此代码从Excel创建Outlook约会。此代码的一部分是在一个AppointmentItem根本不是formattable时在Body中插入一个格式化文本。 它的工作原理如下：

• 我首先创建一个MailItem，然后使用HTMLBody插入并格式化我的文本。
• 甚至不需要显示此项目，我使用命令复制格式化文本（将文本存储在Windows剪贴板[CTRL + C]中）。
• 现在我创建了AppointmentItem并使用另一个命令将文本粘贴到约会正文中（不完全是文本，但是在Windows剪贴板[CTRL + V]中的所有内容）。

嗯，工作正常，但我想避免这个CTRL + C_＆amp; _CTRL + V的事情，如果它是可能的。但这不是我主要担心的，因为我得到了这些“错误”：

• 第一个错误：如果我连续两次加载此代码，它应该显示两个Outlook约会，每个约会都带有格式化文本。但是第一次约会显示文本重复，第二次约会没有显示任何内容。图：

• 第二个错误：我使用代码来解锁Word文档（因为我正在使用 .GetInspector.WordEditor 属性），但即使使用此代码，有时他也会显示此错误并突出显示B5.PasteAndFormat (wdFormatOriginalFormatting)行：

  

此方法或属性不可用，因为文档已被锁定以进行编辑。

但有时候工作正常。

嗯，就是这样，抱歉这个话题太大了。但我不知道发生了什么。

我的代码：

Set oApp = CreateObject("Outlook.Application")
'========================================================================================
'//EMAIL
'========================================================================================
Set ItemEmail = oApp.CreateItem(0)

With ItemEmail
    .HTMLBody = " <b>text text text</b> "
End With

Set A1 = ItemEmail
Set A2 = A1.GetInspector
Set A3 = A2.WordEditor
Set A4 = A3.Range

'//Protected file
Set Protegido = ItemEmail.GetInspector.WordEditor
If Protegido.ProtectionType <> wdNoProtection Then
    Protegido.Unprotect
End If

A4.FormattedText.Copy

ItemEmail.Close (olDiscard)
'________________________________________________________


'========================================================================================
'// APPOINTMENT
'========================================================================================
Set ItemAppoint = oApp.CreateItem(1)

With ItemAppoint
    .Display
End With

'//Protected file
Set Protegido = ItemEmail.GetInspector.WordEditor
If Protegido.ProtectionType <> wdNoProtection Then
    Protegido.Unprotect
End If

Set B1 = ItemAppoint
Set B2 = B1.GetInspector
Set B3 = B2.WordEditor
Set B4 = B3.Application
Set B5 = B4.Selection

B5.PasteAndFormat (wdFormatOriginalFormatting)
'______________________________________________________

Answer 1

如果要使用Excel在Outlook中创建约会，请运行以下脚本。

Private Sub Add_Appointments_To_Outlook_Calendar()

    'Include Microsoft Outlook nn.nn Object Library from Tools -> References
    Dim oAppt As AppointmentItem
    Dim Remind_Time As Double

    i = 2
    Subj = ThisWorkbook.Sheets(1).Cells(i, 1)

    'Loop through entire list of Reminders to be added
    While Subj <> ""
        Set oAppt = Outlook.Application.CreateItem(olAppointmentItem)

        oAppt.Subject = Subj
        oAppt.Location = ThisWorkbook.Sheets(1).Cells(i, 2)
        oAppt.Start = ThisWorkbook.Sheets(1).Cells(i, 3)
        Remind_Time = ThisWorkbook.Sheets(1).Cells(i, 4) * 1 * 60 + ThisWorkbook.Sheets(1).Cells(i, 5) * 60 + ThisWorkbook.Sheets(1).Cells(i, 6)
        oAppt.ReminderMinutesBeforeStart = Remind_Time
        oAppt.AllDayEvent = True
        oAppt.Save

        i = i + 1
        Subj = ThisWorkbook.Sheets(1).Cells(i, 1)
    Wend
    MsgBox "Reminder(s) Added To Outlook Calendar"

End Sub

'代码来自此链接： 'http://officetricks.com/add-appointment-to-outlook-calendar-through-excel-macro-vba/