Question

相对于excel宏而言相对较新，因此需要一点帮助。我已经编写了一段代码来自动将excel中的日历事件列表添加到我的Outlook日历中，我想知道如何将这些事件自动转发/发送到其他人的日历（我可以访问）。 / p>

我正在努力解决的另一件事是，每当我碰到一个空白单元格时，我都会收到一个错误。我想知道每当击中空白单元格时如何停止代码感谢@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

Answer 1

我想知道如何将它们自动转发/发送到其他人的日历（我可以访问）

Outlook对象模型提供了NameSpace.GetSharedDefaultFolder方法，该方法返回一个Folder对象，该对象代表指定用户的指定默认文件夹。在委派方案中使用此方法，在该方案中，一个用户已将其一个或多个默认文件夹（例如，他们的共享Calendar文件夹）委派给另一用户。例如：

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

自动将Outlook约会从Excel发送到其他人的日历

1 个答案: