Bruggemanmark
Gebruiker
- Lid geworden
- 29 sep 2014
- Berichten
- 21
Beste mensen,
Heb op dit forum een bestandje gedownload welke automatisch vanuit excel een taak in outlook vermeld met
omschrijving e.d. Nu wil ik graag dat er bij de omschrijving een extra kolom wordt toegevoegd. Er is nu een kolom met body,
dit moeten er eigenlijk 6 worden. Als ik dit verander krijg ik een foutmelding. Welke code moet ik toevoegen om bijvoorbeeld
kolom J t/m O toe te voegen.
Dit is de code nu:
Private Sub CommandButton1_Click()
Dim blnOutlookQuit As Boolean
Dim lngRow As Long
Dim objFolder As Object
Dim objNamespace As Object
Dim objOutlook As Object
Dim objTask As Object
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
blnOutlookQuit = True
Set objOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(13)
objFolder.Display 'laat folder zien anders foutmelding door remindertime
With Worksheets(1)
For lngRow = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
Set objTask = objOutlook.CreateItem(3)
With objTask
.Subject = CStr(Cells(lngRow, 2).Value)
.StartDate = CDate(Cells(lngRow, 3).Value)
.DueDate = CDate(Cells(lngRow, 4).Value)
.Status = CInt(Cells(lngRow, 5).Value) 'olTaskComplete 2, olTaskDeferred 4, olTaskInProgress 1,olTaskNotStarted 0, olTaskWaiting 3
.Importance = CInt(Cells(lngRow, 6).Value) 'olImportanceHigh 2, olImportanceLow 0, olImportanceNormal 1
.PercentComplete = CInt(Cells(lngRow, 7).Value) '0 ... 100 stuurt mogelijk status
.ReminderSet = CBool(Cells(lngRow, 8).Value) 'true false
.ReminderTime = CDate(Cells(lngRow, 9).Value) 'date and time
.Body = CStr(Cells(lngRow, 10).Value)
.Save
End With
Next
End With
If blnOutlookQuit Then
objOutlook.Quit
End If
Set objTask = Nothing
Set objFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing
End Sub
Alvast bedankt.
Heb op dit forum een bestandje gedownload welke automatisch vanuit excel een taak in outlook vermeld met
omschrijving e.d. Nu wil ik graag dat er bij de omschrijving een extra kolom wordt toegevoegd. Er is nu een kolom met body,
dit moeten er eigenlijk 6 worden. Als ik dit verander krijg ik een foutmelding. Welke code moet ik toevoegen om bijvoorbeeld
kolom J t/m O toe te voegen.
Dit is de code nu:
Private Sub CommandButton1_Click()
Dim blnOutlookQuit As Boolean
Dim lngRow As Long
Dim objFolder As Object
Dim objNamespace As Object
Dim objOutlook As Object
Dim objTask As Object
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
blnOutlookQuit = True
Set objOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(13)
objFolder.Display 'laat folder zien anders foutmelding door remindertime
With Worksheets(1)
For lngRow = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
Set objTask = objOutlook.CreateItem(3)
With objTask
.Subject = CStr(Cells(lngRow, 2).Value)
.StartDate = CDate(Cells(lngRow, 3).Value)
.DueDate = CDate(Cells(lngRow, 4).Value)
.Status = CInt(Cells(lngRow, 5).Value) 'olTaskComplete 2, olTaskDeferred 4, olTaskInProgress 1,olTaskNotStarted 0, olTaskWaiting 3
.Importance = CInt(Cells(lngRow, 6).Value) 'olImportanceHigh 2, olImportanceLow 0, olImportanceNormal 1
.PercentComplete = CInt(Cells(lngRow, 7).Value) '0 ... 100 stuurt mogelijk status
.ReminderSet = CBool(Cells(lngRow, 8).Value) 'true false
.ReminderTime = CDate(Cells(lngRow, 9).Value) 'date and time
.Body = CStr(Cells(lngRow, 10).Value)
.Save
End With
Next
End With
If blnOutlookQuit Then
objOutlook.Quit
End If
Set objTask = Nothing
Set objFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing
End Sub
Alvast bedankt.