For moving a message you need the permission to delete it from the old
folder and add it to the new one.

--
Best regards
Michael Bauer - MVP Outlook

: VBOffice Reporter for Data Analysis & Reporting
: Outlook Categories? Category Manager Is Your Tool
: http://www.vboffice.net/product.html?pub=6&lang=en


Am Mon, 7 Jul 2008 02:53:04 -0700 schrieb Rivers:

Hi micheal sorry for the new string i couldnt find the original (Long
weekend)

i tried your version of the count loop and also tried Kens version of the
step -1 loop all work fine for the first 3-4 emails and then it stops
working. now that the first three emails have been moved it seems to all
ways
flag the same error again without moving anything. its like it doesnt ike
the
specific email. is there any way to catch the error and change te count to
the next heres the code again with your version of the loop

the error message recieved canot move items or the new error message is
PERMISSION DENIED
have tried everyones suggestions but all keep coming up with the same old
error after moving 2-3

sorry again for the repost cant find the original

Private Sub CommandButton1_Click()
'On Error GoTo SaveAttachmentsToFolder_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim subfolder2 As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName, sel As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Dim orecip As Outlook.Recipient
Dim itemcheck As Boolean
Dim myitem As Object
Dim otherInbox As Outlook.MAPIFolder
Dim iCount As Long
Dim i1 As Long
Dim Items As Outlook.Items


Set ns = GetNamespace("MAPI")
Set orecip = ns.CreateRecipient("Air Flash")

If orecip.Resolve() Then
Set otherInbox = ns.GetSharedDefaultFolder(orecip,
olFolderInbox)
Else
MsgBox "No Mailbox"
End If

Set SubFolder = otherInbox.Folders("Flash Recieved")
Set subfolder2 = otherInbox.Folders("Flash Processed")
Set Items = SubFolder.Items

i = 0

If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the Sales Reports folder.",
vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
Dim count2 As Integer
count2 = Item.Attachments.Count
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "\\iodine.euston.uk.ssp\groupshare\Finance\AIR
FINANCE\Financial Analyst\AIR REPORTS\Flash\Air Flash Recieved\" &
Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item


i = 1
Do Until Items.Count = 0
'i = i + 1
Items(1).Move otherInbox.Folders("Flash Processed")
Loop




"Michael Bauer [MVP - Outlook]" wrote:



Please don't start a new thread for the same issue. I gave you an example
for how to do the loop, what don't you like on that? For your variables
it
looks like this:

Dim Items as Outlook.Items
Set Items=Subfolder.Items
Do Until Items.Count = 0
Items(1).Move...
Loop

--
Best regards
Michael Bauer - MVP Outlook

: VBOffice Reporter for Data Analysis & Reporting
: Outlook Categories? Category Manager Is Your Tool
: http://www.vboffice.net/product.html?pub=6&lang=en


Am Mon, 7 Jul 2008 01:06:02 -0700 schrieb Rivers:

I keep getting this error after i have taken the attachments off

"object variable or with block variable not set "

the line that causes it the one below

Item.Move otherInbox.Folders("Flash Processed")

i have included all the code below to help, i think its because i havent
set
move as a variable but not sure if i have to or even what type

thanks for any help

Private Sub CommandButton1_Click()
'On Error GoTo SaveAttachmentsToFolder_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName, sel As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Dim oRecip As Outlook.Recipient
Dim itemcheck As Boolean
Dim myitem As Object
Dim otherInbox As Outlook.MAPIFolder
Dim iCount As Long
Dim i1 As Long


Set ns = GetNamespace("MAPI")
Set oRecip = ns.CreateRecipient("Air Flash")

If oRecip.Resolve() Then
Set otherInbox = ns.GetSharedDefaultFolder(oRecip,
olFolderInbox)
Else
MsgBox "No Mailbox"
End If

Set SubFolder = otherInbox.Folders("Flash Recieved")
i = 0

If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the Sales Reports folder.",
vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments

If Right(Atmt.FileName, 3) = "xls" Then
FileName = "\\iodine.euston.uk.ssp\groupshare\Finance\AIR
FINANCE\Financial Analyst\AIR REPORTS\Flash\Air Flash Recieved\" &
Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item
i = 1



iCount = SubFolder.Items.Count

For i1 = iCount To 1 Step -1
Item.Move otherInbox.Folders("Flash Processed")
Next


' Show summary message
If i 0 Then
varResponse = MsgBox("I found " & i & " attached files." _
& vbCrLf & "I have saved them into the
\\iodine.euston.uk.ssp\groupshare\Finance\AIR FINANCE\Financial
Analyst\AIR
REPORTS\Flash\Air Flash Recieved\." _
& vbCrLf & vbCrLf & "Would you like to view the files now?" _
, vbQuestion + vbYesNo, "Finished!")
' Open Windows Explorer to display saved files if user chooses
If varResponse = vbYes Then
Shell "Explorer.exe
/e,\\iodine.euston.uk.ssp\groupshare\Finance\AIR FINANCE\Financial
Analyst\AIR REPORTS\Flash\Air Flash Recieved\", vbNormalFocus
End If
Else
MsgBox "I didn't find any attached files in your mail.",
vbInformation, "Finished!"
End If
' Clear memory
SaveAttachmentsToFolder_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
' Handle Errors
SaveAttachmentsToFolder_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume SaveAttachmentsToFolder_exit
End Sub


the error line is the