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

Question

亲爱的stackoverflow社区，

您可以看到，我在这个论坛上是新手。最近，我一直在与Internet论坛的指南一起学习VBA。大多数情况下，可用的Q＆amp;与Stackoverflow中的可用Q＆amp;确实可以帮助我解决自己的挑战。但是，我有这个目前找不到解决方案和原因的方法。

我的目标是通过共享文件夹发送Outlook约会，并使用GetInspector复制从Excel Workbook中包含的格式化单元格以创建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 Profis可以指出原因并解释为什么剪贴板的糊状物（这是最后一步）在这种情况下不起作用的原因，我肯定会很感激。

非常感谢。

欢呼

Answer 1

代码对我有用，但这可能是由于可用的内存，处理器速度等 - 因为您正在从excel复制到另一个应用我会使用这种方法（因为它在米利（Mili）几秒钟内，睡眠可能会更好，这完全取决于您的过程以及最适合您的过程）

...
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
...