Hi All,
I have a large range of records in an Excel Spreadsheet (imported from a SQL CE Database to edit offsite). The columns for these records corresponde to some of the Fields within an Oulook TaskItem. So, I run a simple For..Next loop through the range of Excel Records, attaching each iteration to Subject, StartDate and so on.
My problem: When calling the .Save() Outlook Item function/method, nothing appears in my Outlook tasks. Hence, how do I explicitly ensure a destination Email address to where these records have to be posted?
This will help me a lot, because several of my colleagues also need to run this same script on their own machines (on Intranet) as well.
Look forward to any assistance. I have attached my code below for ease of reference:
[VBA]Sub CreateTaskBatch()
' After referencing MS Outlook objects, we can use them in our script
Dim olApp As Outlook.Application
Dim olTsk As TaskItem
Dim RangeStart As Integer ' Used for looping
Dim RangeEnd As Integer ' Used for looping
Dim DueDate As Date
Dim i As Integer
' Set up the Loop Start Point
RangeStart = 2
' Obtain Range End from the Current User (Loop End iterator)
RangeEnd = InputBox("Please supply the last Row Number for your list of Engineering Requests?", "Range End Required")
'RangeEnd = InputBox("Please provide the end of the Range (Number)?", "Require Range End", 2, 100, 100, 0)
' Incorporate a Backdoor Exit for the Loop, in the event that the User enters incorrect information
' or if the User realises that they want to quit this function before it runs. or if nothing is type into Row 2
If (RangeEnd = -1) Or (Sheet1.Cells(RangeStart, "A") = "") Then
olApp = Nothing ' Clear Object from System Memory
olTsk = Nothing ' Clear Task Object from Memory
Exit Sub ' Completely close down the Sub
Else
' If the user entered valid data, continue with Memory Addressing
' and Create new Object instances
Set olApp = New Outlook.Application
Set olTsk = olApp.CreateItem(olTaskItem)
' Set up the Looping function
' We will use a for..next loop since we know the starting and ending points of this loop
' which is from Row 2 (just below column headings) up to whatever row number is last occupied by data
' We set these variables at the very top of this Script
' NOW RUN THE LOOP
For i = RangeStart To RangeEnd
With olTsk
.Subject = Sheet1.Cells(i, "B") ' I hardcode Column Access for easy maintenance later
' i is the current row number within the loop. With each iteration it will increase to (i + 1)
' Supported by the call to "Next i"
.StartDate = Sheet1.Cells(i, "AU")
' I noticed that a lot of the records have nothing n the Due Date column. This will cause programming errors
' so I check here if it is empty, and if so: I set the date to today
If Sheet1.Cells(i, "F") = "" Then
DueDate = Now
Else
.DueDate = Sheet1.Cells(i, "F")
End If
' Since the Engineers type/select a Text version as the Status Option, We must parse
' The physical Text. Thus, I hardcode all the text entries they can possibly make here and
' relate my text entry with an actual MS Outlook Status.Object
Select Case Sheet1.Cells(i, "D")
Case "Completed"
.Status = olTaskComplete
Case "In Progress"
.Status = olTaskInProgress
Case "Deferred"
.Status = olTaskDeferred
Case "Not Started"
.Status = olTaskNotStarted
Case "Waiting on someone"
.Status = olTaskWaiting
End Select
' We will do another Select Statement to establish the Importance/Priority
Select Case Sheet1.Cells(i, "E")
Case "(1) High"
.Importance = olImportanceHigh
Case "(2) Normal"
.Importance = olImportanceNormal
Case "(3) Low"
.Importance = olImportanceLow
End Select
' Percentage Completion (Real Number)
.TotalWork = 100 - Sheet1.Cells(i, "G")
.ActualWork = Sheet1.Cells(i, "G")
.DateCompleted = Sheet1.Cells(i, "AT")
.Owner = Sheet1.Cells(i, "C")
.Save ' Save the Current Loop Iteration Task
.ContactNames = "hendrikp@brolaz.com"
End With
Next i ' Move on to the Next Row
End If
Set olTsk = Nothing
Set olApp = Nothing
MsgBox "The Engineering Request Tasks have uploaded successfully!", vbInformation
End Sub[/VBA]
Reply With Quote
