自动将outlook约会发送给其他人'；从excel中选择日历

相对新的excel宏和什么不那么期待一点帮助。我已经编写了一段代码，可以在outlook日历中自动添加excel中的日历事件列表，我想知道如何将这些事件自动转发/发送到其他人的日历（我有权访问）

还有一件事我正在努力解决，那就是每当我点击空白单元格时，我都会收到一个错误。我想知道，每当空白单元格被点击时，我如何使代码停止谢谢@AndrasDork回答这部分问题

谢谢

    Dim I As Long
    Dim xRg As Range
    Dim xOutApp As Object
    Dim xOutItem As Object
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = Range("A2:G25")
    For I = 1 To xRg.Rows.Count
        Set xOutItem = xOutApp.createitem(1)
        Debug.Print xRg.Cells(I, 1).Value
        xOutItem.Subject = xRg.Cells(I, 1).Value
        xOutItem.Location = xRg.Cells(I, 2).Value
        xOutItem.Start = xRg.Cells(I, 3).Value
        xOutItem.Duration = xRg.Cells(I, 4).Value
        If Trim(xRg.Cells(I, 5).Value) = "" Then
            xOutItem.BusyStatus = 2
        Else
            xOutItem.BusyStatus = xRg.Cells(I, 5).Value
        End If
        If xRg.Cells(I, 6).Value > 0 Then
            xOutItem.ReminderSet = True
            xOutItem.ReminderMinutesBeforeStart = xRg.Cells(I, 6).Value
        Else
            xOutItem.ReminderSet = False
        End If
        xOutItem.Body = xRg.Cells(I, 7).Value
        xOutItem.Save
        Set xOutItem = Nothing
    Next
    Set xOutApp = Nothing
End Sub

Sub ResolveName()  
 Dim myNamespace As Outlook.NameSpace  
 Dim myRecipient As Outlook.Recipient  
 Dim CalendarFolder As Outlook.Folder 

 Set myNamespace = xOutApp.GetNamespace("MAPI")  
 Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev")  

 myRecipient.Resolve  

 If myRecipient.Resolved Then  
   Call ShowCalendar(myNamespace, myRecipient)  
 End If 

End Sub  

Sub ShowCalendar(myNamespace, myRecipient)  
 Dim CalendarFolder As Outlook.Folder 

 Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar) 

 CalendarFolder.Display  
End Sub

我想知道我将如何将这些自动转发/发送到其他人的日历（我有权访问）

Outlook对象模型提供了一种方法，用于返回表示指定用户的指定默认文件夹的

文件夹

对象。此方法用于委派场景，其中一个用户已将其一个或多个默认文件夹（例如，其共享日历文件夹）的访问权委派给另一个用户。例如：

Sub ResolveName()  
 Dim myNamespace As Outlook.NameSpace  
 Dim myRecipient As Outlook.Recipient  
 Dim CalendarFolder As Outlook.Folder 

 Set myNamespace = Application.GetNamespace("MAPI")  
 Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev")  

 myRecipient.Resolve  

 If myRecipient.Resolved Then  
   Call ShowCalendar(myNamespace, myRecipient)  
 End If 

End Sub  

Sub ShowCalendar(myNamespace, myRecipient)  
 Dim CalendarFolder As Outlook.Folder 

 Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar) 

 CalendarFolder.Display  
End Sub

---

@AndrasDorko我很抱歉我不知道，当我回到我的桌面时，我会解决并更改回来，抱歉@AndrasDorko解决了原来的问题，现在也显示了，感谢您的帮助。尝试运行此程序，但没有成功…是否有一个特定的位置，我必须插入此代码相对于我的代码的其余部分，您是否收到任何错误？哪一行代码完全失败？在“Set myNamespace=Application.GetNamespace（“MAP”）行上出现错误。它说“object不支持此属性或方法。请使用

xOutApp

而不是

Application

。现在我在同一行上收到了“object Required”