Sub sample()
Dim i As Long
Dim oApp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.Folder
Set oApp = CreateObject("Outlook.Application")
Set myNameSpace = oApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(9) '規定のフォルダーの指定:9 は予定表・6は受信トレイなので今回は9を指定
myFolder.Display 'Outlookを表示
oApp.ActiveWindow.WindowState = 2 'ウィンドウサイズの指定
Dim task As Outlook.AppointmentItem '予定表
Dim title As String '予定表のタイトル
Dim place As String '予定の場所
Dim Contents As String '予定の内容
Dim Start As String '予定の開始日
Dim Starttime As String '予定の開始時間
Dim ed As String '予定の終了日
Dim edtime As String '予定の終了時間
i = 2
Do Until Cells(i, 1).Value = "" '表が終わるまでループ
'Excelの表のデータを取得
title = Cells(i, 1)
place = Cells(i, 2)
Contents = Cells(i, 3)
Start = Cells(i, 4).Text
Starttime = Cells(i, 5).Text
ed = Cells(i, 6).Text
edtime = Cells(i, 7).Text
'予定表の処理
Set task = oApp.CreateItem(1) 'olAppointmentItem=1 1は予定
task.Display '編集画面表示
'Subject=予定の名前
'Body=予定の内容
'Location=予定の場所
'Start=予定の開始の日時
'End=予定終了の日時
task.Subject = title
task.Body = place
task.Location = Contents
task.Start = Start & " " & Starttime
If ed = "" And Start <> "" Then
ed = Start
End If
task.End = ed & " " & edtime
task.Close 0
i = i + 1
Loop '表の予定がなくなるまで繰り返し
'oApp.Quit 'Outlookを終了、使う場合はコメントアウト!
Set myFolder = Nothing 'プロシージャー終了時に開放されるのは知っているよ!でも一応(笑)
Set myNameSpace = Nothing
Set oApp = Nothing
End Sub
task.Body = place
task.Location = Contents
逆ではないかと思うのですが、これで良いのでしょうか?
コメントありがとうございます!
変数の指定が逆ですね~
お手数ですが変数のセルの指定を変えてご使用をお願いいたします(*_*;