hi, with the help of your code i have now a code that moves non replyed email to another folder but it stoped working. it gives me error at For intCount = objSourceFolder.Items.Count To 1 Step -1 and i dont't know what i did to make it stop working . any help is welcomed. thank you.
'Use the GetFolderPath function to find a folder in non-default mailboxes
Function GETFOLDERPATH(ByVal FolderPath As String) As Outlook.folder
Dim oFolder As Outlook.folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GETFOLDERPATH = Nothing
End If
Next
End If
'Return the oFolder Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GETFOLDERPATH = Nothing
Exit Function
End Function
Sub MoveNONREPLYEDdMail()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objVariant As Variant
Dim intCount As Integer
Dim intDateDiff As Integer
Dim lngMovedItems As Long
Dim propertyAccessor As Outlook.propertyAccessor
Dim myForward As Outlook.MailItem
'On Error Resume Next
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = GETFOLDERPATH("Mailbox - Clients\Inbox\zile arhivare\Azi") 'sursa
'Set objSourceFolder = GETFOLDERPATH("Shared mailbox name\Inbox")
Set objDestFolder = GETFOLDERPATH("Mailbox - Clients\Inbox\zile arhivare\Ieri") 'destinatie
' use a subfolder under Inbox
For intCount = objSourceFolder.Items.Count To 1 Step -1
Set objVariant = objSourceFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then
Set propertyAccessor = objVariant.propertyAccessor
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
If Not propertyAccessor.GetProperty("
http://schemas.microsoft.com/mapi/proptag/0x10810003") = 102 _
And Not propertyAccessor.GetProperty("
http://schemas.microsoft.com/mapi/proptag/0x10810003") = 103 Then
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
If intDateDiff > -1 Then
objVariant.MOVE objDestFolder
lngMovedItems = lngMovedItems + 1
End If
End If
End If
Next
MsgBox "Au fost gasite " & lngMovedItems & " email-uri

"
' Set objDestFolder = Nothing
End Sub