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

发送预约VBA

1 个答案: