アポイントメントを送るVBA

Question

私はこれほど長い間この仕事に取り組んできました。私は予定を作成し、それを誰かに送るボタンを作ろうとしています。これまでのところ、私が望む変数で予定を作成するのに成功しましたが、それを適切な人に送る方法を理解することはできません。それをまったく送信してください。私は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