发送预约VBA

Question

所以，我一直在为WAY这个任务摔跤太久了。我正在尝试创建一个预约并将其发送给某人的按钮。到目前为止，我已经成功地创建了我想要的变量，但我无法弄清楚如何将它发送给合适的人。或者为此发送它。我很新的内VBA的Outlook应用程序，所以，请温柔和我在一起，但这里是我到目前为止的代码：

Sub appt() 

Dim OutApp As Object 
Dim OutMail As Object 
Dim duedate As String 
Dim currentrow As String 
Dim currentsheet As String 
Dim owner As String  

currentsheet = ActiveSheet.Name 
currentrow = Range("C10:C" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row 
duedate = Range("C" & currentrow).Offset(0, 1) 
owner = Range("C" & currentrow).Offset(0, 2) 
With Application 
    .EnableEvents = False 
    .ScreenUpdating = False 
End With 

Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(1) 
On Error Resume Next 
With OutMail 
    .Recipients = Range("M3") 
    .Subject = "Next PDB Task for " & currentsheet 
    .Importance = True 
    .Start = "8:00 AM" & duedate 
    .End = "8:00 AM" & Format(Date + 5) 
    .ReminderMinutesBeforeStart = 10080 
    .Body = "Text and Stuff" 
    .Display 
End With 

Set OutMail = Nothing 
Set OutApp = Nothing 
Unload Emy 
End Sub 

所以，这绝对是抓住我从它的运行在纸张想要的信息，但是它不会去任何地方。我需要使用除.Recipients之外的其他东西吗？是否有可能转发此（与.Forward也许？）？任何帮助将不胜感激！！！

P.S.我想要发送约会的电子邮件地址在单元格M3中。

Answer 1

我没有尝试脚本，但它看起来像他们会做你想做的。

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("Dan Wilson") 
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 

excel vba create appointment in someone elses calendar

Sub MultiCalendars() 
    Dim objPane As Outlook.NavigationPane 
    Dim objModule As Outlook.CalendarModule 
    Dim objGroup As Outlook.NavigationGroup 
    Dim objNavFolder As Outlook.NavigationFolder 
    Dim objFolder As Folder 
    Dim calItem As Object 
    Dim mtgAttendee As Outlook.Recipient 

    Dim i As Integer 

    Set Application.ActiveExplorer.CurrentFolder = Session.GetDefaultFolder(olFolderCalendar) 
    DoEvents 

    Set objPane = Application.ActiveExplorer.NavigationPane 
    Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar) 

    With objModule.NavigationGroups 
     Set objGroup = .GetDefaultNavigationGroup(olMyFoldersGroup) 

    ' To use a different calendar group 
'  Set objGroup = .Item("Shared Calendars") 
    End With 


    For i = 1 To objGroup.NavigationFolders.Count 
     If (objGroup.NavigationFolders.Item(i).Folder.FullFolderPath = "\\Mailbox - Doe, John T\Calendar") Then 
      Set objNavFolder = objGroup.NavigationFolders.Item(i) 
      Set calItem = objNavFolder.Folder.Items.Add(olAppointmentItem) 
      calItem.MeetingStatus = olMeeting 
      calItem.Subject = "Test Meeting - Ignore" 
      calItem.Location = "TBD Location" 
      calItem.Start = #1/19/2015 1:30:00 PM# 
      calItem.Duration = 90 
      Set mtgAttendee = calItem.Recipients.Add("John Doe") 
      mtgAttendee.Type = olRequired 
      Set mtgAttendee = calItem.Recipients.Add("Jane Doe") 
      mtgAttendee.Type = olOptional 
      Set mtgAttendee = calItem.Recipients.Add("CR 101") 
      mtgAttendee.Type = olResource 
      calItem.Save 
      If (calItem.Recipients.ResolveAll) Then 
       calItem.Send 
      Else 
       calItem.Display 
      End If 
     End If 
    Next 

    Set objPane = Nothing 
    Set objModule = Nothing 
    Set objGroup = Nothing 
    Set objNavFolder = Nothing 
    Set objFolder = Nothing 
    Set calItem = Nothing 
    Set mtgAttendee = Nothing 
End Sub 

https://answers.microsoft.com/en-us/office/forum/office_2010-customize/excel-vba-create-an-appointment-in-someone-elses/4c2ec8d1-82f2-4b02-abb7-8c2de2fd7656?auth=1