Compile Error: Object Required

[salman.paracha]

Please help..

I am trying to create an outlook script that will parse the subject line of emails coming from a particular source and organize them, by the ticket number present in the subject line. However, VB is sucking the life out of me on the error below

I am getting a Compile Error: Object Required on the line
Dim subjectLine as String
Set subjectLine = Item.Subject.

If I take the same MailItem (Item) object and pass the Subject property to the MsgBox()
it works...So I am beat on this one bad.

Please view the complete script below...Any and all the help will be greatly appreciated.

Sub CustomMailMessageRule(Item As Outlook.MailItem)
    Const folderInbox = 6
    Const ticketsFldName = "tickets"
    Const nutrioFldName = "nutrio"
    
    Dim objFolder As Outlook.Folder
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(folderInbox)
    
    Dim ticketsFolder As Outlook.Folder
    Dim nutrioFolder As Outlook.Folder
        
    ticketsFolder = objFolder.Folder(ticketsFldName)
    
    If (ticketsFolder Is Nothing) Then
     ticketsFolder = objFolder.Folders.Add(ticketsFldName)
     nutrioFolder = ticketsFolder.Folders.Add(nutrioFldName)
    
    ElseIf (nutrioFolder Is Nothing) Then
     nutrioFolder = ticketsFolder.Folders.Add(nutrioFldName)
    
    End If
    
    Dim subjectLine As String
    Set subjectLine = Item.Subject
    
    Set begIndexHash = InStr(0, "#", subjectLine)
    Set endIndexColon = InStr(0, ":", subjectLine)
    
    Dim ticketNumber As String
    If (begIndexHash = 0 Or endIndexColon = 0) Then
        Return
    Else
        Set ticketNumber = Mid$(subjectLine, begIndexHash + 1, (endIndexColon - begIndexHash) - 1)
    End If
    
    Set ticketNewFolder = nutrioFolder.Folders.Add(ticketNumber)
    Item.Move (ticketNewFolder)

End Sub

[salman.paracha]

I found a bug, which has not solved the problem but just wanted to update the code

 Sub CustomMailMessageRule(Item As Outlook.MailItem)
    Const folderInbox = 6

    Dim objFolder As Outlook.Folder

    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(folderInbox)

    Dim ticketsFolder As Outlook.Folder
    Dim nutrioFolder As Outlook.Folder

    ticketsFolder = objFolder.Folders("tickets")

    If (ticketsFolder Is Nothing) Then
     ticketsFolder = objFolder.Folders.Add(ticketsFldName)
     nutrioFolder = ticketsFolder.Folders.Add(nutrioFldName)

    ElseIf (ticketsFolder.Folders("nutrio") Is Nothing) Then
     nutrioFolder = ticketsFolder.Folders.Add(nutrioFldName)

    End If

    Dim subjectLine As String
    Set subjectLine = Item.Subject

    Set begIndexHash = InStr(0, "#", subjectLine)
    Set endIndexColon = InStr(0, ":", subjectLine)

    Dim ticketNumber As String
    If (begIndexHash = 0 Or endIndexColon = 0) Then
        Return
    Else
        Set ticketNumber = Mid$(subjectLine, begIndexHash + 1, (endIndexColon - begIndexHash) - 1)
    End If

    Set ticketNewFolder = nutrioFolder.Folders.Add(ticketNumber)
    Item.Move (ticketNewFolder)

End Sub

[hopalongcassidy]

The problem is that the variable named "subjectLine" is defined as a String. A String is not an Object. When you use the "Set" statement, the compiler expects that the thing you are "Setting" is an object.

Hoppy

[salman.paracha]

Thanks for the reply....I was just about to post that solution myself...was trying different approaches

Sub CustomMailMessageRule()
    Const folderInbox = 6
    Const ticketsFldName = "tickets"
    Const nutrioFldName = "nutrio"

    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(folderInbox)
    
    Dim ticketsFolder As Outlook.MAPIFolder
    Dim nutrioFolder As Outlook.MAPIFolder
    
    ticketsFolder = objFolder.Folders(ticketsFldName)
    
    If (ticketsFolder Is Nothing) Then
     ticketsFolder = objFolder.Folders.Add(ticketsFldName)
     nutrioFolder = ticketsFolder.Folders.Add(nutrioFldName)
    
    ElseIf (ticketsFolder.Folders(nutrioFldName) Is Nothing) Then
     nutrioFolder = ticketsFolder.Folders.Add(nutrioFldName)
    End If
    
    Dim subjectLine As String
    subjectLine = Item.Subject
    
    Dim begIndexHash As Integer
    Dim endIndexColon As Integer
    
    begIndexHash = InStr(0, "#", subjectLine)
    endIndexColon = InStr(0, ":", subjectLine)
    
    Dim ticketNumber As String
    If (begIndexHash = 0 Or endIndexColon = 0) Then
        Return
    Else
        ticketNumber = Mid$(subjectLine, begIndexHash + 1, (endIndexColon - begIndexHash) - 1)
    End If
    
    Dim ticketNewFolder As Outlook.MAPIFolder
    ticketNewFolder = nutrioFolder.Folders.Add(ticketNumber)
    
    Item.Move (ticketNewFolder)
    
End Sub

But now I am getting another wierd error...maybe you can help with this

I am getting Run Time Error:
"The operation Failed: An object could not be found" on
ticketsFolder = objFolder.Folders(ticketsFldName)

All help will be greatly appreciated

[hopalongcassidy]

Once again, "ticketsFolder" IS and object and requires a "Set". This distinction in syntax is kind of a stupid rule in VB, but it's something you have to live with.

Hoppy

[salman.paracha]

Thanks for your help...Here is the final script that works...

Sub CustomMailMessageRule(Item As Outlook.MailItem)
    On Error GoTo PROBLEM
    
    Const folderInbox = 6
    Const ticketsFldName = "tickets"
    Const nutrioFldName = "nutrio"
    
    Dim objFolder As Outlook.Folder
    Dim ticketsFolder As Outlook.Folder
    Dim nutrioFolder As Outlook.Folder
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(folderInbox)

    
    
    Set ticketsFolder = Nothing
    Set nutrioFolder = Nothing
       
    Set ticketsFolder = objFolder.Folders(ticketsFldName)

    If (ticketsFolder Is Nothing) Then
        Set ticketsFolder = objFolder.Folders.Add(ticketsFldName)
        Set nutrioFolder = ticketsFolder.Folders.Add(nutrioFldName)
    Else
        Set nutrioFolder = ticketsFolder.Folders(nutrioFldName)
        If (nutrioFolder Is Nothing) Then
            Set nutrioFolder = ticketsFolder.Folders.Add(nutrioFldName)
        End If
        
    End If
        
    Dim subjectLine As String
    Dim begIndexHas As Integer
    Dim endIndexColon As Integer
    Dim ticketNumber As String
    
    subjectLine = Item.Subject
    begIndexHash = InStr(subjectLine, "#")
    endIndexColon = InStr(begIndexHash, subjectLine, ":")

    If (begIndexHash = 0 Or endIndexColon = 0) Then
        Exit Sub
    Else
        ticketNumber = Mid$(subjectLine, begIndexHash + 1, (endIndexColon - begIndexHash - 1))
    End If
    
    Dim ticketNewFolder As Outlook.Folder
    
    Set ticketNewFolder = Nothing
    Set ticketNewFolder = nutrioFolder.Folders(ticketNumber)
    
    If (ticketNewFolder Is Nothing) Then
        Set ticketNewFolder = nutrioFolder.Folders.Add(ticketNumber)
    End If
    
    Item.Move ticketNewFolder
    
PROBLEM:
    If (Err.Number = 424) Then
    MsgBox (Err.Description & Err.Number)
    End If
    
    Resume Next
End Sub

[salman.paracha]

If a folder that you are trying to access does not exists, it will throw an exception, and therefore you will have to catch that exception and resume to the next line, where you will create that folder...

[mahdouch5]

please help me in Private Sub bt1_Click()

please
pleaaaaaaaaaaaaaaaaaaase

Private Sub balance_Click()

Dim sc As Single
Dim sd As Single

sc = 0
sd = 0

For i = 0 To listcr.ListCount - 1
sc = sc + CSng(List.List(i))

Next i
For j = 0 To listde.ListCount - 1
sd = sd + CSng(List.List(j))

Next j
totcr.Caption = sc
totde.Caption = sd
totb = sc - sd

End Sub

Private Sub bt1_Click()

If opt1.Value = True Then

listcr.AddItem (t1.Text)
listde.AddItem ("0")

Else
listcr.AddItem (t1.Text)
listcr.addltem ("0")
End If

End Sub

Private Sub bt2_Click()

listcr.RemoveItem (listcr.ListCount - 1)
listde.RemoveItem (listde.ListCount - 1)

balance_Click
End Sub

Private Sub bt3_Click()

End

End Sub

Private Sub Form_Load()
bt1.Enabled = False
bt2.Enabled = False

End Sub

Private Sub t1_Change()
If t1.Text <> "" Then
bt1.Enabled = True
bt2.Enabled = True
End If
End Sub

Private Sub t1_validate(cancel As Boolean)

If Not IsNumeric(t1.Text) Then
cancel = True
Else
cancel = False
End If
End Sub

picture in error

http://www.daniweb.com/forums/attachment.php?attachmentid=13906&stc=1&d=1267662681