Final answer: Creating an Outlook Task from MS Word 2000 
Author Message
 Final answer: Creating an Outlook Task from MS Word 2000

I have pasted below the final code that Astrid had worked out for me. I
thought that others in the group may benefit from this.

Thanks again Astrid.

Regards
Vera Hawkins

-------------------------------

Option Explicit

 Dim bStarted As Boolean
 Dim oOutlookApp As Outlook.Application
 Dim oNameSpace As Outlook.NameSpace

 Sub ReadTableFormFields()
 Dim oCell As Cell
 Dim oTable As Table
 Dim oFormfield As FormField
 Dim oRow As Row
 Dim sFormSubject As String
 Dim sFormRecipient As String
 Dim sFormDate As Date

   'First start Outlook
   StartOutlook

   'If your table is not the first table
   'in the document, replace the .Tables(1)
   'with the index of your table
   Set oTable = ActiveDocument.Tables(1)
   'Loop through all the rows in the table
   For Each oRow In oTable.Rows
     'Check if there are formfields in this
     'row of the table
     If oRow.Range.FormFields.Count > 0 Then

      If Len(oRow.Cells(1).Range.FormFields(1).Result) > 0 Then
       sFormSubject = oRow.Cells(1).Range.FormFields(1).Result
      Else
        GoTo Finished
      End If

      If Len(oRow.Cells(2).Range.FormFields(1).Result) > 0 Then
       sFormRecipient = oRow.Cells(2).Range.FormFields(1).Result
      Else
        GoTo Finished
      End If

      If Len(oRow.Cells(3).Range.FormFields(1).Result) > 0 Then
       sFormDate = oRow.Cells(3).Range.FormFields(1).Result
      Else
        GoTo Finished
      End If

       'Create the task
       WriteOutlookTask sSubject:=sFormSubject, _
                        dDueDate:=CDate(sFormDate), _
                        sRecipient:=sFormRecipient
     End If
   Next

Finished:
  CloseOutlook
  MsgBox "All tasks have been sent.", vbOKOnly + vbInformation
  Exit Sub

 End Sub

 Function StartOutlook() As Boolean
   On Error Resume Next
   Set oOutlookApp = GetObject(, "Outlook.Application")
   If Err <> 0 Then
     Set oOutlookApp = CreateObject("Outlook.Application")
     bStarted = True
   End If
   Set oNameSpace = oOutlookApp.GetNamespace("MAPI")
 End Function

 Sub CloseOutlook()
   'Only close Outlook if we started
   'it programmatically
   If bStarted Then oOutlookApp.Quit
   Set oNameSpace = Nothing
   Set oOutlookApp = Nothing
 End Sub

 Sub WriteOutlookTask(sSubject As String, dDueDate As Date, _
                      sRecipient As String)
 Dim oNewTask As Outlook.TaskItem

   Set oNewTask = _
 oNameSpace.GetDefaultFolder(olFolderOutbox).Items.Add(olTaskItem)

   With oNewTask
     .Assign
     .Subject = sSubject
     .StartDate = Now
     .Recipients.Add Name:=sRecipient
     .Recipients.ResolveAll
     .DueDate = dDueDate
     .
     .Save
   End With
   oNewTask.Send

   Set oNewTask = Nothing

 End Sub



Tue, 24 Jun 2003 10:57:24 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Repost: Creating an Outlook Task from MS Word 2000

2. Creating an Outlook Task from MS Word 2000

3. Find Tasks created from MS Project 2000 in Outlook 2000

4. Calling MS-Word from button event click on outlook 98/2000

5. Linking Access 2000 Table to Outlook 2000 Tasks

6. Create task's in MS Outlook from VB4.0 application

7. Create task's in MS Outlook from VB4.0 application

8. Question regarding MAPI, MS Outlook 2000, and Outlook Express 6

9. MS PJ 2000 and MS Word via VBA

10. Outlook 2000 to Word 2000 document merge problem

11. How to find the answered date in Outlook 2000

12. Answer Wizard found topics not displaying in Word 2000

 

 
Powered by phpBB® Forum Software