I decided to start a new post because my other was answered, and I was
starting to get off the initial topic with a new question. How can I prevent
duplicates from being entered into the Task list? I may open an Excel tool on
Monday and update tasks for individuals. By the end of the week, as some time
has passed and new tasks are required, but some remain the same (or may not
be done until the following week, or instance), I want to run the code again,
but I don't want to enter the same name and time into my Task list (because
it is already there). I only want to enter the name and time if the name
and/or time is different. Can this be done? I am controlling everything from
Excel.

Below is my code; everything works fine...just want to set up a method to
prevent duplicate Tasks from being entered into the Task list in Outlook:
Sub GetOutlookReference()

Range("K2:K100").Clear
Range("E2:E100").Select
Selection.Copy
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
Range("A1").Select


'Outlook objects
Dim olApp As Outlook.Application

'Obtain a reference to Outlook
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")

'*********************************************
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer

i = 2
j = 2
k = 2
l = 2

Do Until Cells(i, 5).Value = ""
'*********************************************
Dim objApp As Object
Dim OutTask As Object

Set objApp = CreateObject("Outlook.Application")
Set OutTask = objApp.CreateItem(olTaskItem)
With OutTask
.StartDate = Cells(i, 5).Value
.Subject = Cells(j, 3).Value
.Body = Cells(k, 1).Value & " - " & Cells(l, 4).Value
.Importance = olImportanceHigh
'.Display
.ReminderSet = True
'.ReminderTime = [NextPM]
'.DueDate = [NextPM]
'.ReminderPlaySound = True
'.ReminderSoundFile = "C:\WINNT\Media\Ding.wav"
.Save
'.Close
End With
'*********************************************
l = l + 1
k = k + 1
j = j + 1
i = i + 1
Loop

'If Outlook isn't running, start it and remember
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If

' If Outlook still isn't running, Outlook cannot open or is not installed
If olApp Is Nothing Then
Call MsgBox("Outlook could not be opened. Exiting macro.", _
vbCritical, Application.Name)
End If

'Send the emial from here
If Range("L1").Value > Range("K1").Value Then
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook


With Destwb
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Task Roll Ups... " & Sourcewb.Name & " " & Format(Now,
"dd-mmm-yy h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "Ryan@MAPart.com"
.CC = ""
.BCC = ""
.Subject = "Task Roll Ups"
.Body = "Please see attached..."
.Attachments.Add Destwb.FullName
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If

End Sub

I feel like a lost sheep; not sure what to do next... Any help would be
greatly appreciated.

Regards,
Ryan--

--
RyGuy

Archived from group: microsoft>public>outlook>program_vba