MS-Word 2010 - テーブルをOutlookタスクにエクスポートするマクロ

Question

MS-Wordテーブルの内容を（ブックマーク付きの名前で）取得するためにマクロを作成しようとしています。テーブルを作成し、MS-Outlookでタスクを作成します（1行= 1タスク）。

私はGoogleで検索し、私は私が発見した一緒に次の2つのスクリプトを試してみて、混在させる必要があるだろうと思いき：

スクリプト1 - （カレンダーエントリを作成するために - たかったが、反復行通じない - たかった）

Sub AddAppntmnt() 
'Adds a list of events contained in a three column Word table 
'with a header row, to Outlook Calendar 
Dim olApp As Object 
Dim olItem As Object 
Dim oTable As Table 
Dim i As Long 
Dim bStarted As Boolean 
Dim strStartDate As Range 
Dim strEndDate As Range 
Dim strSubject As Range 
On Error Resume Next 
Set olApp = GetObject(, "Outlook.Application") 
If Err <> 0 Then 
Set olApp = CreateObject("Outlook.Application") 
bStarted = True 
End If 
Set oTable = ActiveDocument.Tables(1) 

'Ignore the first (header) row of the table 
For i = 2 To oTable.Rows.Count 
Set strStartDate = oTable.Cell(i, 1).Range 
strStartDate.End = strStartDate.End - 1 
Set strEndDate = oTable.Cell(i, 2).Range 
strEndDate.End = strEndDate.End - 1 
Set strSubject = oTable.Cell(i, 3).Range 
strSubject.End = strSubject.End - 1 
Set olItem = olApp.CreateItem(1) 
olItem.Start = strStartDate 
olItem.End = strEndDate 
olItem.ReminderSet = False 
olItem.AllDayEvent = True 
olItem.Subject = strSubject 
olItem.Categories = "Events" 
olItem.BusyStatus = 0 
olItem.Save 
Next i 
If bStarted Then olApp.Quit 
Set olApp = Nothing 
Set olItem = Nothing 
Set oTable = Nothing 
End Sub 

スクリプト2は - 私はこの1つは2週間か何かで何かをするユーザーを思い出させるためにタスクを設定することについてですが、私は必要だと思う実際のタスク作成ビットを持っています

Sub AddOutlookTask() 
Dim olApp As Object 
Dim olItem As Object 
Dim bStarted As Boolean 
Dim fName As String 
Dim flName As String 
On Error Resume Next 
If ActiveDocument.Saved = False Then 
ActiveDocument.Save 
If Err.Number = 4198 Then 
MsgBox "Process ending - document not saved!" 
GoTo UserCancelled: 
End If 
End If 
Set olApp = GetObject(, "Outlook.Application") 
If Err <> 0 Then 
'Outlook wasn't running, start it from code 
Set olApp = CreateObject("Outlook.Application") 
bStarted = True 
End If 
Set olItem = olApp.CreateItem(3) 'Task Item 
fName = ActiveDocument.name 
flName = ActiveDocument.FullName 
olItem.Subject = "Follow up " & fName 
olItem.Body = "If no reply to" & vbCr & _ 
flName & vbCr & "further action required" 
olItem.StartDate = Date + 10 '10 days from today 
olItem.DueDate = Date + 14 '14 days from today 
olItem.Importance = 2 'High 
olItem.Categories = InputBox("Category?", "Categories") 
olItem.Save 
UserCancelled: 
If bStarted Then olApp.Quit 
Set olApp = Nothing 
Set olItem = Nothing 
End Sub 

MS-Wordの特定のテーブルをコードでどのように参照するのですか？私はそれがブックマークしているので、それが "名前"を持っているので、助けてください！

Answer 1

Davidsヘルプ（上記）を使用して、私は私の問題に次の解決策を得ました。私は空の行に対処するためにこれに追加していく予定

Sub CreateTasks() 
' 
' CreateTasks Macro 
' 
' 
' 
'Exports the contents of the ACtoins table to MS-Outlook Tasks 

' Set Variables 
Dim olApp As Object 
Dim olItem As Object 
Dim oTable As Table 
Dim i As Long 
Dim strSubject As Range 
Dim strDueDate As Range 
Dim strBody As Range 
Dim strSummary As String 

Dim bStarted As Boolean 
'Dim strPupil As WdBookmark 
Dim strPerson As Range 


'Link to Outlook 
On Error Resume Next 
Set olApp = GetObject(, "Outlook.Application") 
If Err <> 0 Then 
Set olApp = CreateObject("Outlook.Application") 
bStarted = True 
End If 

'Set table variable to the bookmarked table 
Set oTable = ActiveDocument.Bookmarks("Actions").Range.Tables(1) 

'Ignore the first (header) row of the table 
For i = 3 To oTable.Rows.Count 

Set strSubject = oTable.Cell(i, 3).Range 
strSubject.End = strSubject.End - 1 


Set strBody = oTable.Cell(i, 4).Range 
strBody.End = strBody.End - 1 

Set strDueDate = oTable.Cell(i, 5).Range 
strDueDate.End = strDueDate.End - 1 



'next line not working below 
'Set strPupil = WdBookmark.Name 


'Create the task 
Set olItem = olApp.CreateItem(3) 'Task Item 

strSummary = Left(strSubject, 30) 

olItem.Subject = "CYPP Action for" & " " & strBody & "-" & strSummary & "..." 
olItem.Body = strBody & vbNewLine & olItem.Body & vbNewLine & strSubject 
olItem.DueDate = strDueDate & olItem.DueDate 
olItem.Categories = "CYPP" 
olItem.Save 

Next i 


If bStarted Then olApp.Quit 
Set olApp = Nothing 
Set olItem = Nothing 
Set oTable = Nothing 


End Sub 

が、私は、これまでの機能には満足しています：彼らは同様の問題に遭遇した場合、私は他の人のためにここに投稿します。 DateDueはまだ動作していませんが、フォーマット上の問題だと思います。

David David、

リチャード。