Erro variavel with

[rafaelsetti]

Boa noite, tem como detectar o erro que não consigo encontrar de váriavel with neste código ?? poderiam me ajudar ??

Obrigado,

Rafael

Sub altera()

Dim PERGUNTA, PERGUNTA2, PERGUNTA3, PERGUNTA4, PERGUNTA5, PERGUNTA6, PERGUNTA7, DECISAO, DECISAO2, DECISAO3, DECISAO4, DECISAO5, DECISAO6, DECISAO7

Dim OL As Outlook.Application

Dim olAppt As TaskItem

Dim NS As Outlook.Namespace

Dim colItems As Outlook.Items

Dim olApptSearch As TaskItem

Dim r As Long, sSubject As String, sBody As String

Dim dStartDate As Date, dDueDate As Date

Dim sSearch As String, bOLOpen As Boolean

Dim s As Worksheet

On Error Resume Next

Set OL = GetObject("Outlook.Application")

bOLOpen = True

If OL Is Nothing Then

Set OL = CreateObject("Outlook.Application")

bOLOpen = False

End If

Set NS = OL.GetNamespace("MAPI")

Set colItems = NS.GetDefaultFolder(olFolderTasks).Items

PERGUNTA = "DIGITE O ASSUNTO:"

DECISAO = InputBox(PERGUNTA)

PERGUNTA2 = "DIGITE O DATA INICIO:"

DECISAO2 = InputBox(PERGUNTA2)

PERGUNTA3 = "DIGITE O HORA INICIO:"

DECISAO3 = InputBox(PERGUNTA3)

PERGUNTA4 = "DIGITE O HORA TÉRMINO:"

DECISAO4 = InputBox(PERGUNTA4)

PERGUNTA5 = "DIGITE O LOCAL:"

DECISAO5 = InputBox(PERGUNTA5)

PERGUNTA6 = "DIGITE A CATEGORIA:"

DECISAO6 = InputBox(PERGUNTA6)

PERGUNTA7 = "DIGITE O CORPO DA MENSAGEM:"

DECISAO7 = InputBox(PERGUNTA7)

For r = 2 To 5

If Len(Worksheets("Outlook").Cells(r, 1).Value) = 0 Then GoTo NextRow

If DECISAO <> "" Then

If Worksheets("Outlook").Cells(r, 1).Value = Texttitulo Then

Worksheets("Outlook").Cells(r, 1).Value = DECISAO

sSubject = Worksheets("Outlook").Cells(r, 1).Value

End If

If DECISAO2 <> "" Then

Worksheets("Outlook").Cells(r, 2).Value = DECISAO2

dStartDate = Worksheets("Outlook").Cells(r, 2).Value

Worksheets("Outlook").Cells(r, 4).Value = DECISAO2

dDueDate = Worksheets("Outlook").Cells(r, 4).Value

End If

If DECISAO3 <= "23:59" Then

Worksheets("Outlook").Cells(r, 3).Value = DECISAO3

dStartTIME = Worksheets("Outlook").Cells(r, 3).Value

End If

If DECISAO4 < "23:59" Then

Worksheets("Outlook").Cells(r, 5).Value = DECISAO4

dDueTIME = Worksheets("Outlook").Cells(r, 5).Value

End If

If DECISAO6 <> "" Then

Worksheets("Outlook").Cells(r, 6).Value = DECISAO6

dCATEGORIES = Worksheets("Outlook").Cells(r, 6).Value

End If

If DECISAO5 <> "" Then

Worksheets("Outlook").Cells(r, 7).Value = DECISAO5

dLOCATION = Worksheets("Outlook").Cells(r, 7).Value

End If

If DECISAO7 <> "" Then

Worksheets("Outlook").Cells(r, 8).Value = DECISAO7

dBODY = Worksheets("Outlook").Cells(r, 8).Value

End If

End If

sSubject = Worksheets("OUTLOOK").Cells(r, 1).Value

dStartDate = Worksheets("OUTLOOK").Cells(r, 2).Value

dDueDate = Worksheets("OUTLOOK").Cells(r, 4).Value

dStartTIME = Worksheets("OUTLOOK").Cells(r, 3).Value

dDueTIME = Worksheets("OUTLOOK").Cells(r, 5).Value

dLOCATION = Worksheets("OUTLOOK").Cells(r, 6).Value

dCATEGORIES = Worksheets("OUTLOOK").Cells(r, 7).Value

dBODY = Worksheets("OUTLOOK").Cells(r, 8).Value

sSearch = "[subject] = " & sQuote(sSubject)

Set olApptSearch = colItems.Find(sSearch)

'If olApptSearch Is Nothing Then

' Set olAppt = OL.CreateItem(olTaskItem)

' olAppt.subject = sSubject

' olAppt.StartDate = dStartDate

' olAppt.DueDate = dDueDate

'olAppt.StartTime = dStartTIME

'olAppt.DueTIME = dDueTIME

'olAppt.Location = dLOCATION

'olAppt.Categories = dCATEGORIES

'olAppt.Body = dBODY

'olAppt.Close olSave

'End If

If RESP <> "1" Then

Set olApptSearch = colItems.Find(sSearch)

If olAppt.subject = Texttitulo Then

Set olAppt = OL.updateitem(olTaskItem)

olAppt.subject = sSubject

olAppt.StartDate = dStartDate

olAppt.DueDate = dDueDate

olAppt.StartTime = dStartTIME

olAppt.DueTIME = dDueTIME

olAppt.Categories = dCATEGORIES

olAppt.Location = dLOCATION

olAppt.Body = dBODY

olAppt.Close olSave

End If

End If

NextRow:

Next r

If bOLOpen = False Then OL.Quit

End Sub