Excel のデータをほかのユーザーの予定表に書き込むマクロ


コメントにて以下のようなご要望をいただきました。


備品の管理をOUTLOOK2010(Exchange)で行う事になり、こちらのマクロ
を参考にしようとしたのですが、知識が乏しくなかなか思った通りに
ならない状況です。

掲載されているマクロでは「会議出席依頼」を送信する仕組みですが、
共有設定されているフォルダ(ユーザ?)に「予定」を入れるように
することは出来ないでしょうか。


備品の管理用のメールボックスの予定表への書き込み権限か、メールボックス自体のフルメールボックス権限を持つユーザーであれば、GetSharedDefaultFolder メソッドでほかのメールボックスの予定表を開くことができます。
Excel で以下のようなデータがある場合に、管理用のメールボックスに直接予定を書き込む Excel のマクロをご紹介しましょう。

  A B C D E F
1 日付 開始時刻 終了時刻 件名 場所 受信者
2 2012/10/27 10:00 10:30 予定1 会議室1 equip1
3 2012/11/3 11:00 12:00 予定2 会議室2 equip2

マクロは以下の通りです。このマクロは Excel で実行します。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub PublishOtherscalendar()
    Dim olkApp 'As Outlook.Application
    Dim objRecp 'As Outlook.Recipient
    Dim fldAppt 'As Outlook.Folder
    Dim objAppt 'As Outlook.AppointmentItem
    Dim r As Integer
    ' Outlook アプリケーションを作成
    Set olkApp = CreateObject("Outlook.Application")
    ' 2 行目から開始
    r = 2
    ' A 列が空欄になるまで繰り返す
    While Sheet1.Cells(r, 1) <> ""
        ' F 列の受信者を取得
        Set objRecp = olkApp.Session.CreateRecipient(Sheet1.Cells(r, 6))
        objRecp.Resolve
        ' 受信者の予定表フォルダーを取得
        Set fldAppt = olkApp.Session.GetSharedDefaultFolder(objRecp, 9) ' olFolderCalendar
        ' 予定アイテムを作成
        Set objAppt = fldAppt.Items.Add
        ' 予定の日時や件名、場所を設定して保存
        objAppt.Start = CDate(Sheet1.Cells(r, 1) & " " & CDate(Sheet1.Cells(r, 2)))
        objAppt.End = CDate(Sheet1.Cells(r, 1) & " " & CDate(Sheet1.Cells(r, 3)))
        objAppt.Subject = Sheet1.Cells(r, 4)
        objAppt.Location = Sheet1.Cells(r, 5)
        objAppt.Save
        ' 次の行へ
        r = r + 1
    Wend
End Sub

マクロの登録方法やメニューへの追加について

広告

Excel のデータをほかのユーザーの予定表に書き込むマクロ」への2件のフィードバック

  1. はじめまして。outlookのVBAを作りたいと思い勉強中ですが、まったく資料がなく困っています。。
    outlook2003で受信トレイのフォルダ内のフォルダをデスクトップにある同じ名前のフォルダに移動し、
    メールはmsgファイルで格納したいと思っています。

    outlookの受信トレイ デスクトップのメール格納
    フォルダA   →   フォルダA(中身のメールは、受信日時+件名.msgとつける)
    フォルダB   →   フォルダB
    フォルダC   →   フォルダC
    フォルダD   →   フォルダD
    フォルダE   →   フォルダE

    その際に、そのフォルダに入っているメールの添付ファイルも別に保存したいです。

    outlookの受信トレイ デスクトップの添付ファイル格納
    フォルダA   →   フォルダA(さらにプロパティの各担当者の事業所をみて、フォルダを作成AA)
    フォルダB   →   フォルダB
    フォルダC   →   フォルダC
    フォルダD   →   フォルダD
    フォルダE   →   フォルダE

    添付ファイルは重複することもあります。

    現在outlookで作成していますが、excelVBAでも作成は可能でしょうか?
    outlook2003だとボタンを作れないと聞いたので・・・ まだ途中のツールです。

    Sub btnSET_Click()
    Dim objOL As Object ‘OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object ‘名前空間
    Dim objFLD As Object ‘フォルダー
    Dim objMAIL As Object ‘メールアイテム

    ‘アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject(“Outlook.Application”)

    ‘Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace(“MAPI”)

    ‘フォルダーの下、第二階層.Foldersでループさせる
    For Each objFLD In objNAMESPC.GetDefaultFolder(olFolderInbox).Folders
    ‘フォルダー名で格納フォルダを変える
    If objFLD.Name = “フォルダA” Then

    ‘フォルダーのアイテム数分ループ Folders.Items
    For Each objMAIL In objFLD.Items
    ‘処理(メール格納と添付ファイルの格納)

    Next objMAIL
    End If
    Next objFLD

    End Sub

    ただここまで作っておきながら、GetSharedDefaultFolderで作り変えないといけないことがわかりました。。。
    別アカウントのメールボックスの中で処理したいです。

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中