Question

亲爱的Stackoverflow社区，

如你所见，我是这个论坛的新手。最近，我一直在通过互联网论坛的指南学习VBA。大多数时候，stackoverflow中可用的Q＆amp; As确实帮助我解决了我的挑战。但是，我有这个，直到现在我找不到解决方案和理由。

我的目标是通过共享文件夹发送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 profis可以指出原因并且解释为什么来自剪贴板的粘贴（这是最后一步）在这种情况下不起作用，我当然会感激不尽。

非常感谢提前。

干杯

Answer 1

代码对我有用，但可能是因为可用的内存，处理器速度等 - 因为你从excel复制到另一个应用程序 - 我在PowerPoint中遇到了类似的情况，我会用这个方法（sleep可能会更好，因为它基于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
...

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

1 个答案: