Well, I finally got it working. There seemed to be a problem with the
iCounter at one point; I think that has been resolved. Also, an error kept
coming up; I added a small line of code in an attempt to manage the error. I
may test it a little more, but it appears to function fine after several
trials. Thanks to everyone!!



Sub GetOutlookReference()

Setwarnings = False
'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 objOutlookApp = 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")
Set objOutlook = 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("J1").Value = Range("I1").Value Then

Dim FileExtStr As String
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 = "Part of " & 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 = "[email protected]" '& ""
.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
Call DeleteDuplicateTask

End Sub


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j totalcount) And (myItems(j).Class olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
On Error GoTo Here
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
newTask.Delete
End If
Next i

He
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox "Duplicate Tasks were detected and deleted!", vbInformation,
"Duplicates detected"
'MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

'*********************************** End of code ***


--
RyGuy


"Sue Mosher [MVP-Outlook]" wrote:

The only reason this blanks the subject is that Remove is an undeclared variable and so is treated as a null string. Add an Option Explicit statement to the declarations section of your code module to avoid being similarly misled in the future.

As Aravind said newTask.Delete would is the correct method to call to delete the item. And if you're just going to delete it, what's the point of changing the Mileage or Subject property?

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"ryguy7272" wrote in message ...

I tried things like this:
newTask.Subject = Remove

This removes the Subject from the Task (appropriate, right).

If this code is running in Excel then any reference to Application will mean
Excel.Application, not Outlook.Application. The VBA intrinsic Application
object refers to the application that VBA is running under.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"ryguy7272" wrote in message
news
Well, I finally got it working. There seemed to be a problem with the
iCounter at one point; I think that has been resolved. Also, an error
kept
coming up; I added a small line of code in an attempt to manage the error.
I
may test it a little more, but it appears to function fine after several
trials. Thanks to everyone!!



Sub GetOutlookReference()

Setwarnings = False
'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 objOutlookApp = 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")
Set objOutlook = 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("J1").Value = Range("I1").Value Then

Dim FileExtStr As String
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 = "Part of " & 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 = "[email protected]" '& ""
.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
Call DeleteDuplicateTask

End Sub


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j totalcount) And (myItems(j).Class olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
On Error GoTo Here
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
newTask.Delete
End If
Next i

He
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox "Duplicate Tasks were detected and deleted!", vbInformation,
"Duplicates detected"
'MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

'*********************************** End of code ***


--
RyGuy

Yes, Ken, you are 100% correct. I think I compensated appropriately with
this line:
Set OutApp = CreateObject("Outlook.Application")

That's what I'm using; I think that's right.


Thanks for everything!
Ryan--

--
RyGuy


"Ken Slovak - [MVP - Outlook]" wrote:

If this code is running in Excel then any reference to Application will mean
Excel.Application, not Outlook.Application. The VBA intrinsic Application
object refers to the application that VBA is running under.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"ryguy7272" wrote in message
news
Well, I finally got it working. There seemed to be a problem with the
iCounter at one point; I think that has been resolved. Also, an error
kept
coming up; I added a small line of code in an attempt to manage the error.
I
may test it a little more, but it appears to function fine after several
trials. Thanks to everyone!!



Sub GetOutlookReference()

Setwarnings = False
'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 objOutlookApp = 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")
Set objOutlook = 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("J1").Value = Range("I1").Value Then

Dim FileExtStr As String
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 = "Part of " & 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 = "[email protected]" '& ""
.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
Call DeleteDuplicateTask

End Sub


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j totalcount) And (myItems(j).Class olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
On Error GoTo Here
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
newTask.Delete
End If
Next i

He
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox "Duplicate Tasks were detected and deleted!", vbInformation,
"Duplicates detected"
'MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

'*********************************** End of code ***


--
RyGuy