Filters in VBA

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi!, i need to do filters with VBA, but, i need to do how is the better wway
to do that.

i do this code on the bottom. Its Work, but, where for example the emails
adress is the second email addres for To field, is a problem. And for
example, many emails the TO filed is just the first word of the email address
(wwp) and no the entire address.

how i do it???? can you tell me??

Thanks a lot.
Ruben

Public Sub CustomFilters(ItemEmail As MailItem, ObjElistas As Object,
TotalItems As Integer)
Dim str As String

Dim Lcibernautas As Outlook.MAPIFolder
Set Lcibernautas = ObjElistas.Folders.Item("Cibernaut@s")
Dim Ljavascript As Outlook.MAPIFolder
Set Ljavascript = ObjElistas.Folders.Item("javascript")
Dim Lvsayuda As Outlook.MAPIFolder
Set Lvsayuda = ObjElistas.Folders.Item("vsayuda")
Dim Ltrucostecnicos As Outlook.MAPIFolder
Set Ltrucostecnicos = ObjElistas.Folders.Item("trucostecnicos")
Dim Llwp As Outlook.MAPIFolder
Set Llwp = ObjElistas.Folders.Item("lwp")
Dim LMundoPc As Outlook.MAPIFolder
Set LMundoPc = ObjElistas.Folders.Item("MundoPc")
Dim Lwwp As Outlook.MAPIFolder
Set Lwwp = ObjElistas.Folders.Item("wwp")

Dim SendTo As String
SendTo = ItemEmail.To
Select Case SendTo
Case "(e-mail address removed)"
ItemEmail.Move Lcibernautas
Case "(e-mail address removed)"
ItemEmail.Move Ljavascript
Case "(e-mail address removed)"
ItemEmail.Move Lvsayuda
Case "vsayuda"
ItemEmail.Move Lvsayuda
Case "(e-mail address removed)"
ItemEmail.Move Ltrucostecnicos
Case "lwp"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move LMundoPc
Case "(e-mail address removed)"
ItemEmail.Move Lwwp

End Select
totalprocess = totalprocess + 1
str = "[" & totalprocess & "/" & TotalItems & "] " & ItemEmail.Subject
CountOfItems.Caption = str
PBarItems.Value = totalprocess
DoEvents
If (totalprocess = TotalItems) Then
Set Lcibernautas = Nothing
Set Ljavascript = Nothing
Set Lvsayuda = Nothing
End If

End Sub
 
Instead of using the value of the To property, you should loop through the item's Recipients collection and examine the Address and/or Name property of each Recipient.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
Hi!.
I do that, but, the property Address didn't found it.

Here is the all code, I wait for your tricks.
Ah!, your book is excelent, i just read it at all...

Thanks.
-----------
Private Sub MoveElistasItems()

Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim ObjElistas As Outlook.MAPIFolder
Dim ElistasEmail As Outlook.MailItem

Dim str As String

On Error Resume Next

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set m_DNSBlackListItems = objInbox.Folders.Item("DNSBlackList").Items
Set m_BayesianItems = objInbox.Folders.Item("Bayesian").Items
Set m_HeaderItems = objInbox.Folders.Item("Header").Items
Set m_KeywordItems = objInbox.Folders.Item("Keyword").Items

Set ObjElistas = objInbox.Folders.Item("Elistas.net")

TotalItems = m_DNSBlackListItems.Count + m_BayesianItems.Count +
m_HeaderItems.Count + m_KeywordItems.Count + objInbox.Items.Count
totalprocess = 0

PBarItems.Value = 0
PBarItems.Max = TotalItems
PBarItems.Min = 0


For i = objInbox.Items.Count To 1 Step -1
Set ElistasEmail = objInbox.Items.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_DNSBlackListItems.Count To 1 Step -1
Set ElistasEmail = m_DNSBlackListItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_BayesianItems.Count To 1 Step -1
Set ElistasEmail = m_BayesianItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_HeaderItems.Count To 1 Step -1
Set ElistasEmail = m_HeaderItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_KeywordItems.Count To 1 Step -1
Set ElistasEmail = m_KeywordItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

If TotalItems = 0 Then
str = "No Items To Process."
Else
str = "Finish Proccessing " & TotalItems & " items."
End If

CountOfItems.Caption = str
btnClose.Enabled = True
End Sub

Public Sub CustomFilters(ItemEmail As MailItem, ObjElistas As Object,
TotalItems As Integer)
Dim str As String

Dim Lcibernautas As Outlook.MAPIFolder
Set Lcibernautas = ObjElistas.Folders.Item("Cibernaut@s")
Dim Ljavascript As Outlook.MAPIFolder
Set Ljavascript = ObjElistas.Folders.Item("javascript")
Dim Lvsayuda As Outlook.MAPIFolder
Set Lvsayuda = ObjElistas.Folders.Item("vsayuda")
Dim Ltrucostecnicos As Outlook.MAPIFolder
Set Ltrucostecnicos = ObjElistas.Folders.Item("trucostecnicos")
Dim Llwp As Outlook.MAPIFolder
Set Llwp = ObjElistas.Folders.Item("lwp")
Dim LMundoPc As Outlook.MAPIFolder
Set LMundoPc = ObjElistas.Folders.Item("MundoPc")
Dim Lwwp As Outlook.MAPIFolder
Set Lwwp = ObjElistas.Folders.Item("wwp")

Dim SendTo As String
SendTo = ItemEmail.To
Select Case SendTo
Case "(e-mail address removed)"
ItemEmail.Move Lcibernautas
Case "(e-mail address removed)"
ItemEmail.Move Ljavascript
Case "(e-mail address removed)"
ItemEmail.Move Lvsayuda
Case "vsayuda"
ItemEmail.Move Lvsayuda
Case "(e-mail address removed)"
ItemEmail.Move Ltrucostecnicos
Case "lwp"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move LMundoPc
Case "(e-mail address removed)"
ItemEmail.Move Lwwp

End Select
totalprocess = totalprocess + 1
str = "[" & totalprocess & "/" & TotalItems & "] " & ItemEmail.Subject
CountOfItems.Caption = str
PBarItems.Value = totalprocess
DoEvents
If (totalprocess = TotalItems) Then
Set Lcibernautas = Nothing
Set Ljavascript = Nothing
Set Lvsayuda = Nothing
End If

End Sub

Thanks!

----------------

Sue Mosher said:
Instead of using the value of the To property, you should loop through the item's Recipients collection and examine the Address and/or Name property of each Recipient.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Ruben said:
Hi!, i need to do filters with VBA, but, i need to do how is the better wway
to do that.

i do this code on the bottom. Its Work, but, where for example the emails
adress is the second email addres for To field, is a problem. And for
example, many emails the TO filed is just the first word of the email address
(wwp) and no the entire address.

how i do it???? can you tell me??

Thanks a lot.
Ruben

Public Sub CustomFilters(ItemEmail As MailItem, ObjElistas As Object,
TotalItems As Integer)
Dim str As String

Dim Lcibernautas As Outlook.MAPIFolder
Set Lcibernautas = ObjElistas.Folders.Item("Cibernaut@s")
Dim Ljavascript As Outlook.MAPIFolder
Set Ljavascript = ObjElistas.Folders.Item("javascript")
Dim Lvsayuda As Outlook.MAPIFolder
Set Lvsayuda = ObjElistas.Folders.Item("vsayuda")
Dim Ltrucostecnicos As Outlook.MAPIFolder
Set Ltrucostecnicos = ObjElistas.Folders.Item("trucostecnicos")
Dim Llwp As Outlook.MAPIFolder
Set Llwp = ObjElistas.Folders.Item("lwp")
Dim LMundoPc As Outlook.MAPIFolder
Set LMundoPc = ObjElistas.Folders.Item("MundoPc")
Dim Lwwp As Outlook.MAPIFolder
Set Lwwp = ObjElistas.Folders.Item("wwp")

Dim SendTo As String
SendTo = ItemEmail.To
Select Case SendTo
Case "(e-mail address removed)"
ItemEmail.Move Lcibernautas
Case "(e-mail address removed)"
ItemEmail.Move Ljavascript
Case "(e-mail address removed)"
ItemEmail.Move Lvsayuda
Case "vsayuda"
ItemEmail.Move Lvsayuda
Case "(e-mail address removed)"
ItemEmail.Move Ltrucostecnicos
Case "lwp"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move LMundoPc
Case "(e-mail address removed)"
ItemEmail.Move Lwwp

End Select
totalprocess = totalprocess + 1
str = "[" & totalprocess & "/" & TotalItems & "] " & ItemEmail.Subject
CountOfItems.Caption = str
PBarItems.Value = totalprocess
DoEvents
If (totalprocess = TotalItems) Then
Set Lcibernautas = Nothing
Set Ljavascript = Nothing
Set Lvsayuda = Nothing
End If

End Sub
Click to expand...
Click to expand...
 
I don't see that you're using Recipients as I suggested earlier. You're still using SendTo = ItemEmail.To

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Ruben said:
Hi!.
I do that, but, the property Address didn't found it.

Here is the all code, I wait for your tricks.
Ah!, your book is excelent, i just read it at all...

Thanks.
-----------
Private Sub MoveElistasItems()

Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim ObjElistas As Outlook.MAPIFolder
Dim ElistasEmail As Outlook.MailItem

Dim str As String

On Error Resume Next

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set m_DNSBlackListItems = objInbox.Folders.Item("DNSBlackList").Items
Set m_BayesianItems = objInbox.Folders.Item("Bayesian").Items
Set m_HeaderItems = objInbox.Folders.Item("Header").Items
Set m_KeywordItems = objInbox.Folders.Item("Keyword").Items

Set ObjElistas = objInbox.Folders.Item("Elistas.net")

TotalItems = m_DNSBlackListItems.Count + m_BayesianItems.Count +
m_HeaderItems.Count + m_KeywordItems.Count + objInbox.Items.Count
totalprocess = 0

PBarItems.Value = 0
PBarItems.Max = TotalItems
PBarItems.Min = 0


For i = objInbox.Items.Count To 1 Step -1
Set ElistasEmail = objInbox.Items.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_DNSBlackListItems.Count To 1 Step -1
Set ElistasEmail = m_DNSBlackListItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_BayesianItems.Count To 1 Step -1
Set ElistasEmail = m_BayesianItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_HeaderItems.Count To 1 Step -1
Set ElistasEmail = m_HeaderItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_KeywordItems.Count To 1 Step -1
Set ElistasEmail = m_KeywordItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

If TotalItems = 0 Then
str = "No Items To Process."
Else
str = "Finish Proccessing " & TotalItems & " items."
End If

CountOfItems.Caption = str
btnClose.Enabled = True
End Sub

Public Sub CustomFilters(ItemEmail As MailItem, ObjElistas As Object,
TotalItems As Integer)
Dim str As String

Dim Lcibernautas As Outlook.MAPIFolder
Set Lcibernautas = ObjElistas.Folders.Item("Cibernaut@s")
Dim Ljavascript As Outlook.MAPIFolder
Set Ljavascript = ObjElistas.Folders.Item("javascript")
Dim Lvsayuda As Outlook.MAPIFolder
Set Lvsayuda = ObjElistas.Folders.Item("vsayuda")
Dim Ltrucostecnicos As Outlook.MAPIFolder
Set Ltrucostecnicos = ObjElistas.Folders.Item("trucostecnicos")
Dim Llwp As Outlook.MAPIFolder
Set Llwp = ObjElistas.Folders.Item("lwp")
Dim LMundoPc As Outlook.MAPIFolder
Set LMundoPc = ObjElistas.Folders.Item("MundoPc")
Dim Lwwp As Outlook.MAPIFolder
Set Lwwp = ObjElistas.Folders.Item("wwp")

Dim SendTo As String
SendTo = ItemEmail.To
Select Case SendTo
Case "(e-mail address removed)"
ItemEmail.Move Lcibernautas
Case "(e-mail address removed)"
ItemEmail.Move Ljavascript
Case "(e-mail address removed)"
ItemEmail.Move Lvsayuda
Case "vsayuda"
ItemEmail.Move Lvsayuda
Case "(e-mail address removed)"
ItemEmail.Move Ltrucostecnicos
Case "lwp"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move LMundoPc
Case "(e-mail address removed)"
ItemEmail.Move Lwwp

End Select
totalprocess = totalprocess + 1
str = "[" & totalprocess & "/" & TotalItems & "] " & ItemEmail.Subject
CountOfItems.Caption = str
PBarItems.Value = totalprocess
DoEvents
If (totalprocess = TotalItems) Then
Set Lcibernautas = Nothing
Set Ljavascript = Nothing
Set Lvsayuda = Nothing
End If

End Sub

Thanks!

----------------

Sue Mosher said:
Instead of using the value of the To property, you should loop through the item's Recipients collection and examine the Address and/or Name property of each Recipient.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Ruben said:
Hi!, i need to do filters with VBA, but, i need to do how is the better wway
to do that.

i do this code on the bottom. Its Work, but, where for example the emails
adress is the second email addres for To field, is a problem. And for
example, many emails the TO filed is just the first word of the email address
(wwp) and no the entire address.

how i do it???? can you tell me??

Thanks a lot.
Ruben

Public Sub CustomFilters(ItemEmail As MailItem, ObjElistas As Object,
TotalItems As Integer)
Dim str As String

Dim Lcibernautas As Outlook.MAPIFolder
Set Lcibernautas = ObjElistas.Folders.Item("Cibernaut@s")
Dim Ljavascript As Outlook.MAPIFolder
Set Ljavascript = ObjElistas.Folders.Item("javascript")
Dim Lvsayuda As Outlook.MAPIFolder
Set Lvsayuda = ObjElistas.Folders.Item("vsayuda")
Dim Ltrucostecnicos As Outlook.MAPIFolder
Set Ltrucostecnicos = ObjElistas.Folders.Item("trucostecnicos")
Dim Llwp As Outlook.MAPIFolder
Set Llwp = ObjElistas.Folders.Item("lwp")
Dim LMundoPc As Outlook.MAPIFolder
Set LMundoPc = ObjElistas.Folders.Item("MundoPc")
Dim Lwwp As Outlook.MAPIFolder
Set Lwwp = ObjElistas.Folders.Item("wwp")

Dim SendTo As String
SendTo = ItemEmail.To
Select Case SendTo
Case "(e-mail address removed)"
ItemEmail.Move Lcibernautas
Case "(e-mail address removed)"
ItemEmail.Move Ljavascript
Case "(e-mail address removed)"
ItemEmail.Move Lvsayuda
Case "vsayuda"
ItemEmail.Move Lvsayuda
Case "(e-mail address removed)"
ItemEmail.Move Ltrucostecnicos
Case "lwp"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move LMundoPc
Case "(e-mail address removed)"
ItemEmail.Move Lwwp

End Select
totalprocess = totalprocess + 1
str = "[" & totalprocess & "/" & TotalItems & "] " & ItemEmail.Subject
CountOfItems.Caption = str
PBarItems.Value = totalprocess
DoEvents
If (totalprocess = TotalItems) Then
Set Lcibernautas = Nothing
Set Ljavascript = Nothing
Set Lvsayuda = Nothing
End If

End Sub
Click to expand...
Click to expand...
Click to expand...
 
yea, im sorry.
I do now that, i used the recipiest colecction, and its work fine.
thanks a lot!
Ruben

Public Sub CustomFilters(ItemEmail As MailItem, ObjElistas As Object,
TotalItems As Integer)
Dim str As String

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

Dim SendTo As String
Dim AddressSendTo() As String

For Each reci In ItemEmail.Recipients
Call MoveItems(reci.Address, ItemEmail, ObjElistas)
Next
totalprocess = totalprocess + 1

str = "[" & totalprocess & "/" & TotalItems & "] " & ItemEmail.Subject
CountOfItems.Caption = str
PBarItems.Value = totalprocess
DoEvents

End Sub



Sue Mosher said:
I don't see that you're using Recipients as I suggested earlier. You're still using SendTo = ItemEmail.To

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Ruben said:
Hi!.
I do that, but, the property Address didn't found it.

Here is the all code, I wait for your tricks.
Ah!, your book is excelent, i just read it at all...

Thanks.
-----------
Private Sub MoveElistasItems()

Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim ObjElistas As Outlook.MAPIFolder
Dim ElistasEmail As Outlook.MailItem

Dim str As String

On Error Resume Next

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set m_DNSBlackListItems = objInbox.Folders.Item("DNSBlackList").Items
Set m_BayesianItems = objInbox.Folders.Item("Bayesian").Items
Set m_HeaderItems = objInbox.Folders.Item("Header").Items
Set m_KeywordItems = objInbox.Folders.Item("Keyword").Items

Set ObjElistas = objInbox.Folders.Item("Elistas.net")

TotalItems = m_DNSBlackListItems.Count + m_BayesianItems.Count +
m_HeaderItems.Count + m_KeywordItems.Count + objInbox.Items.Count
totalprocess = 0

PBarItems.Value = 0
PBarItems.Max = TotalItems
PBarItems.Min = 0


For i = objInbox.Items.Count To 1 Step -1
Set ElistasEmail = objInbox.Items.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_DNSBlackListItems.Count To 1 Step -1
Set ElistasEmail = m_DNSBlackListItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_BayesianItems.Count To 1 Step -1
Set ElistasEmail = m_BayesianItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_HeaderItems.Count To 1 Step -1
Set ElistasEmail = m_HeaderItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

For i = m_KeywordItems.Count To 1 Step -1
Set ElistasEmail = m_KeywordItems.Item(i)
Call CustomFilters(ElistasEmail, ObjElistas, TotalItems)
Next
Set ElistasEmail = Nothing

If TotalItems = 0 Then
str = "No Items To Process."
Else
str = "Finish Proccessing " & TotalItems & " items."
End If

CountOfItems.Caption = str
btnClose.Enabled = True
End Sub

Public Sub CustomFilters(ItemEmail As MailItem, ObjElistas As Object,
TotalItems As Integer)
Dim str As String

Dim Lcibernautas As Outlook.MAPIFolder
Set Lcibernautas = ObjElistas.Folders.Item("Cibernaut@s")
Dim Ljavascript As Outlook.MAPIFolder
Set Ljavascript = ObjElistas.Folders.Item("javascript")
Dim Lvsayuda As Outlook.MAPIFolder
Set Lvsayuda = ObjElistas.Folders.Item("vsayuda")
Dim Ltrucostecnicos As Outlook.MAPIFolder
Set Ltrucostecnicos = ObjElistas.Folders.Item("trucostecnicos")
Dim Llwp As Outlook.MAPIFolder
Set Llwp = ObjElistas.Folders.Item("lwp")
Dim LMundoPc As Outlook.MAPIFolder
Set LMundoPc = ObjElistas.Folders.Item("MundoPc")
Dim Lwwp As Outlook.MAPIFolder
Set Lwwp = ObjElistas.Folders.Item("wwp")

Dim SendTo As String
SendTo = ItemEmail.To
Select Case SendTo
Case "(e-mail address removed)"
ItemEmail.Move Lcibernautas
Case "(e-mail address removed)"
ItemEmail.Move Ljavascript
Case "(e-mail address removed)"
ItemEmail.Move Lvsayuda
Case "vsayuda"
ItemEmail.Move Lvsayuda
Case "(e-mail address removed)"
ItemEmail.Move Ltrucostecnicos
Case "lwp"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move LMundoPc
Case "(e-mail address removed)"
ItemEmail.Move Lwwp

End Select
totalprocess = totalprocess + 1
str = "[" & totalprocess & "/" & TotalItems & "] " & ItemEmail.Subject
CountOfItems.Caption = str
PBarItems.Value = totalprocess
DoEvents
If (totalprocess = TotalItems) Then
Set Lcibernautas = Nothing
Set Ljavascript = Nothing
Set Lvsayuda = Nothing
End If

End Sub

Thanks!

----------------

Sue Mosher said:
Instead of using the value of the To property, you should loop through the item's Recipients collection and examine the Address and/or Name property of each Recipient.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Hi!, i need to do filters with VBA, but, i need to do how is the better wway
to do that.

i do this code on the bottom. Its Work, but, where for example the emails
adress is the second email addres for To field, is a problem. And for
example, many emails the TO filed is just the first word of the email address
(wwp) and no the entire address.

how i do it???? can you tell me??

Thanks a lot.
Ruben

Public Sub CustomFilters(ItemEmail As MailItem, ObjElistas As Object,
TotalItems As Integer)
Dim str As String

Dim Lcibernautas As Outlook.MAPIFolder
Set Lcibernautas = ObjElistas.Folders.Item("Cibernaut@s")
Dim Ljavascript As Outlook.MAPIFolder
Set Ljavascript = ObjElistas.Folders.Item("javascript")
Dim Lvsayuda As Outlook.MAPIFolder
Set Lvsayuda = ObjElistas.Folders.Item("vsayuda")
Dim Ltrucostecnicos As Outlook.MAPIFolder
Set Ltrucostecnicos = ObjElistas.Folders.Item("trucostecnicos")
Dim Llwp As Outlook.MAPIFolder
Set Llwp = ObjElistas.Folders.Item("lwp")
Dim LMundoPc As Outlook.MAPIFolder
Set LMundoPc = ObjElistas.Folders.Item("MundoPc")
Dim Lwwp As Outlook.MAPIFolder
Set Lwwp = ObjElistas.Folders.Item("wwp")

Dim SendTo As String
SendTo = ItemEmail.To
Select Case SendTo
Case "(e-mail address removed)"
ItemEmail.Move Lcibernautas
Case "(e-mail address removed)"
ItemEmail.Move Ljavascript
Case "(e-mail address removed)"
ItemEmail.Move Lvsayuda
Case "vsayuda"
ItemEmail.Move Lvsayuda
Case "(e-mail address removed)"
ItemEmail.Move Ltrucostecnicos
Case "lwp"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move Llwp
Case "(e-mail address removed)"
ItemEmail.Move LMundoPc
Case "(e-mail address removed)"
ItemEmail.Move Lwwp

End Select
totalprocess = totalprocess + 1
str = "[" & totalprocess & "/" & TotalItems & "] " & ItemEmail.Subject
CountOfItems.Caption = str
PBarItems.Value = totalprocess
DoEvents
If (totalprocess = TotalItems) Then
Set Lcibernautas = Nothing
Set Ljavascript = Nothing
Set Lvsayuda = Nothing
End If

End Sub
Click to expand...
Click to expand...
Click to expand...
 
Back
Top