發送預約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