Excelからデフォルト以外のOutlook予定表への予定のロード

Question

私は、従業員が共有カレンダーまたはグローバルカレンダーに予定を残して、管理者が何週目にそれを誰に見せるかを確認できるプロジェクトに取り組んでいます。

予定を共有カレンダーまたはグローバルカレンダーに保存できません。私のデフォルトカレンダーに保存します。私はいくつかのアプローチを試みました。現在の方法です：

Sub Create_Outlook_2() 
' Create the Outlook session 

Dim oApp As Object 
Dim oNameSpace As Namespace 
Dim oFolder As Object 
Dim myApt As AppointmentItem 


Set oApp = New Outlook.Application 
Set oNameSpace = oApp.GetNamespace("MAPI") 
Set oFolder = oNameSpace.GetFolderFromID("000000007CF129E6C6BAA74F9B2AB399FABB280E01006EC36FFC70429B4EAE1875321A4609670078C4FA00320000").Items.Add(olAppointmentItem) 



With oFolder 
    ' Set myOutlook = CreateObject("Outlook.Application") 
' ' Set data collection to take from "Leave Table" sheet 
    Dim wsSrc As Worksheet 
    Set wsSrc = Sheets("Leave Table") 
    ' Start looping at row 3 (first two rows are for readability) 
    r = 3 
    ' Do/while set condition 
    Do Until Trim(wsSrc.Cells(r, 1).Value) = "" 
     ' Create event item 
     Set myApt = oApp.CreateItem(1) 
     ' Set the event properties 
     ' Set Subject line of event 
    With myApt 
     .Subject = "Time Off " & wsSrc.Cells(r, 1).Value & " " & wsSrc.Cells(r, 2).Value 
     ' Set start time 
     .Start = DateValue(wsSrc.Cells(r, 3)) + wsSrc.Cells(r, 8).Value 
     ' Set end time 
     .End = DateValue(wsSrc.Cells(r, 3)) + wsSrc.Cells(r, 9).Value 
     ' Turn reminders off 
     .ReminderSet = False 
     ' Set busy status to free 
     .BusyStatus = 0 
     ' Have the body of the event read as the decription from the leave form in Viewpoint 
     .Body = wsSrc.Cells(r, 4).Value 
     ' Save event in owners calendar 
     .Save 

     End With 
     ' Move to next row 
     r = r + 1 
     ' Repeat do/while loop until condition is no longer valid 
    Loop 

End With 
End Sub 

デフォルトのカレンダーにはまだ保存されています。

Answer 1

私はそれを理解しました！

このコードは動作します：あなたが選択した（良い測定のための新しいウィンドウで開きます）で予定を作成するカレンダー、押すだけで
：

Sub Create_Outlook_2() 

    Dim oApp As Object 
    Dim oNameSpace As Namespace 
    Dim oFolder As Object 
    Dim wsSrc As Worksheet 
    Set wsSrc = Sheets("Leave Table") 
    ' Start looping at row 3 (first two rows are for readability) 
    r = 3 
    ' Do/while set condition 
    Do Until Trim(wsSrc.Cells(r, 1).Value) = "" 

    ' Create the Outlook session 
    Set oApp = New Outlook.Application 
    ' Set the namespace 
    Set oNameSpace = oApp.GetNamespace("MAPI") 
    ' Set the folder the appointment will be created in. 
    Set oFolder = oNameSpace.GetFolderFromID("Folder ID Number").Items.Add(olAppointmentItem) 

    ' Set with block for the appointment configuration loop 
    With oFolder 
     ' Set Subject line of event 
     .Subject = wsSrc.Cells(r, 1).Value & " " & wsSrc.Cells(r, 2).Value 
     ' Set start time 
     .Start = DateValue(wsSrc.Cells(r, 3)) + wsSrc.Cells(r, 8).Value 
     ' Set end time 
     .End = DateValue(wsSrc.Cells(r, 3)) + wsSrc.Cells(r, 9).Value 
     ' Turn reminders off 
     .ReminderSet = False 
     ' Set busy status to free 
     .BusyStatus = 0 
     ' Have the body of the event read as the decription from the leave form in Viewpoint 
     .Body = wsSrc.Cells(r, 4).Value 
     ' Save event in owners calendar 
     .Save 
     ' End with block 
     End With 
     ' Move to next row 
     r = r + 1 
     ' Repeat do/while loop until condition is no longer valid 
    Loop 

End Sub 

があなたのフォルダのID番号を取得するにはOutlookのマクロを起動し、 "ThisOutlookSession" の下に次のコードを実行するために、F11：

Private Sub GetOutlookFolderID() 
    'Determines the Folder ID of Folder 
    Dim olfolder As Outlook.MAPIFolder 
    Dim olapp As Outlook.Application 
    Set olapp = CreateObject("Outlook.Application") 
    Set olfolder = olapp.GetNamespace("MAPI").PickFolder 
    olfolder.Display 
    MsgBox (olfolder.EntryID) 
    Set olfolder = Nothing 
    Set olapp = Nothing 
End Sub 

THE EXCEL SPREADSHEET I AM USING
- 偽の名前で

私はこの件に関して今日非常に多くの記事とスレッドを読んでいますが、どれも働いていません。私の苦しみが他の貧しい人を助けてくれることを願っています！

このサイトを素晴らしいものにしてくれた皆様に特別なおかげです！基本的なVBAとSQLのやり方を自分自身で教えて三日を経た後、私はこのサイトとそれに貢献するすべての人々に大変感謝します。

最高の運があります！

Answer 2

Outlookで予定表を作成する場合は、Excelを使用して、以下のスクリプトを実行します。

Private Sub Add_Appointments_To_Outlook_Calendar() 

    'Include Microsoft Outlook nn.nn Object Library from Tools -> References 
    Dim oAppt As AppointmentItem 
    Dim Remind_Time As Double 

    i = 2 
    Subj = ThisWorkbook.Sheets(1).Cells(i, 1) 

    'Loop through entire list of Reminders to be added 
    While Subj <> "" 
     Set oAppt = Outlook.Application.CreateItem(olAppointmentItem) 

     oAppt.Subject = Subj 
     oAppt.Location = ThisWorkbook.Sheets(1).Cells(i, 2) 
     oAppt.Start = ThisWorkbook.Sheets(1).Cells(i, 3) 
     Remind_Time = ThisWorkbook.Sheets(1).Cells(i, 4) * 1 * 60 
     oAppt.ReminderMinutesBeforeStart = Remind_Time 
     oAppt.AllDayEvent = True 
     oAppt.Save 

     i = i + 1 
     Subj = ThisWorkbook.Sheets(1).Cells(i, 1) 
    Wend 
    MsgBox "Reminder(s) Added To Outlook Calendar" 

End Sub 

"のコードは、このリンクから来ている： http://officetricks.com/add-appointment-to-outlook-calendar-through-excel-macro-vba/

スクリプトは、Excelから実行され、そしてあなたは、コードを実行する前などは、Outlookへの参照を設定する必要があります。また、スクリプトを実行するには、ワークシートを適切に設定する必要があります。このように見えるはずです。すべてがExcelからOutlookに読み込まれます。

Answer 3

代わりにIDを取得するフォルダにアクセスするための追加の方法があります：

Set oFolder = oNameSpace.Folders.Item("account address").Folders.Item("Calendar").Items.Add(olAppointmentItem) 

「アカウントのアドレスは、」アカウントさらに

のメールアドレスである場合には、私は」複数のoutlook.comカレンダーを使用していて、デフォルト以外のカレンダーのいずれかにアクセスするには、次の操作を行うことができます：

Set oFolder = oNameSpace.Folders.Item("account address").Folders.Item("Calendar").Folders.Item("Other calendar name").Items.Add(olAppointmentItem) 

投稿なしでこれを行うことはできませんでした.Joshua。ありがとう！