通过与VBA的共享文件夹发送Outlook约会邀请中的Getinspector

Question

尊敬的Stackoverflow社区，

如您所见，我是该论坛的新手。 最近，我通过与Internet论坛上的指南一起学习VBA。 大多数情况下，stackoverflow中可用的常见问题解答确实可以帮助我解决挑战。 但是，我有一个我到目前为止找不到解决方案和原因的解决方案。

我的目标是通过共享文件夹发送Outlook约会，并使用getinspector将格式化的单元格包含从excel工作簿复制到创建的Outlook约会。 如果我分别完成每个任务，那么一切都会很好。 当我集成代码时，getinspector似乎不再起作用。 以下是我使用的代码（如果代码看上去不专业，请原谅我，因为我一直在论坛的帮助下自己学习VBA）：

Sub VBA_Appointment()

Dim objOL   As outlook.Application
Dim objAppt As outlook.AppointmentItem
Dim objFolder As Object
Dim objRecip As outlook.recipient
Dim strName As String
Dim wrdrng As Word.Range
Dim Doc As Word.document

Application.ScreenUpdating = False
Application.EnableEvents = False

Const olAppointmentItem = 1
Const olFolderCalender = 9

Set objOL = CreateObject("Outlook.Application")
Set objAppt = objOL.CreateItem(olAppointmentItem)
Set Doc = objAppt.GetInspector.WordEditor
Set objNS = objOL.Application.GetNamespace("MAPI")
Set objFolder = objNS.Folders

strName = "John Smith"

Set objRecip = objNS.CreateRecipient(strName)
Set objFolder = objNS.GetsharedDefaultFolder(objRecip, olFolderCalender)

With objAppt
.Subject = "Testing"
.MeetingStatus = 1
.RequiredAttendees = ""
.Start = Now
.Location = ""
.BusyStatus = 1 '0=free;1=Tentative;2=Busy
'Copy desired data from EXCEL sheet and paste on the opened OUTLOOK Appointment
ThisWorkbook.Sheets("Sheet1").Range("A1:B50").Copy
Set wrdrng = Doc.Range
.Display
wrdrng.Paste
Application.CutCopyMode = False
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

Set objAppt = Nothing
Set objOL = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objRecip = Nothing

End Function

因此，如果有人VBA专业人士能指出原因并解释为什么剪贴板中的粘贴（这是最后一步）在这种情况下不起作用的原因，我将不胜感激。

提前谢谢了。

干杯

Answer 1

该代码为我工作，但可能是由于可用内存，处理器速度等-因为您是从excel复制到另一个应用程序-我在PowerPoint中遇到了类似情况，所以我会使用这种方法（ 睡眠，因为它以毫秒为单位，完全取决于您的过程以及最适合您的过程）

...
ThisWorkbook.Sheets("Sheet1").Range("A1:B50").Copy
Application.Wait Now + TimeValue("00:00:01")
Set wrdrng = Doc.Range
.Display
'if it doesn't work above, paste it here (both would be too much time and not really needed)
Application.Wait Now + TimeValue("00:00:01")
wrdrng.Paste
Application.CutCopyMode = False
End With
...