Attatchment detach issues VB-Help

  • Thread starter Thread starter Rivers
  • Start date Start date
R

Rivers

hi peeps thanks before hand for any help you can give,

i found this code on a website that pulls the attatchments off of the emails
and stores them into a specified folder. its brilliant except for a few tiny
gltches i have found.

1. All the emails are not being processed (i put a count in along with a
messagebox to check, i put 12 emails into the folder with only xls files but
ony 7 get transfered)
2. if the email hs multilple attatchments it only takes one

can anyone help with this? i have put below the code

thanks again

Rivers

For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
sel = SubFolder.Items.Count
MsgBox sel

If Right(Atmt.FileName, 3) = "xls" Then

FileName = "C:\Documents and Settings\me\My Documents\Email
Attachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
Item.Move otherInbox.Folders("Flash Processed")
i = i + 1
End If
Next Atmt
Next Item
 
That code moves the item after processing the first attachment, so no others
can be processed. Also, in any loop where you're moving/deleting items from
a collection you should use a count down for loop, not for...each. The Items
collection count is changing as you move items so a for...each will process
only half the items in a collection:

For i = SubFolder.Items.Count To 1 Step -1
 
ok ken being as though it was down to my thnking on my last query that caused
the problem in the first lace is this what you meant?
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments

If Right(Atmt.FileName, 3) = "xls" Then
FileName = "\\ Flash Recieved\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item

For Each Item In SubFolder.Items
Item.Move otherInbox.Folders("Flash Processed")
Next Item

however my attatchments all copy across but when it comes to my for lop to
move my items to a new folder it completes half then stops??

thanks before hand

Rivers
 
thanks anyway figured it out needed a do loop wit a for statement

Do Until itemcheck = True
If SubFolder.Items.Count <> 0 Then
For Each Item In SubFolder.Items
Item.Move otherInbox.Folders("Flash Processed")
Next Item
Else
itemcheck = True
End If
Loop

works perfectly
 
You're still better off using the count down For loop I showed rather than a
For...Each loop. That's best practice when moving or deleting items from a
collection.
 
Ken your right it doesnt work now it ran through once but now keeps giving
error

ive never written a step loop before can you help

Do Until SubFolder.Items.Count = 0
For Each Item In SubFolder.Items
Item.Move otherInbox.Folders("Flash Processed")
Next Item
Loop
 
Dim iCount As Long
iCount = SubFolder.Items.Count

Dim i As Long

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

Also, Move is a function and returns an object reference to the newly moved
item. Often things work better when you get the returned object, even as a
throw-away item object that isn't used.
 
Done as requested Ken but now getting a new error message Lol,

"object variable or with block variable not set "

any ideas?
 
Not without seeing the code as it stands now, and not without knowing what
line causes the error.
 
hi ken

this is the code thanks

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
 
Is "Flash Processed" a subfolder of that Inbox folder? In other words does
it actually exist? Does the user logon the code is running under have
permissions to create new items in that folder and to remove items from the
source folder?

What happens if you instantiate a MAPIFolder object for
otherInbox.Folders("Flash Processed"), does it result in a valid folder
object reference?
 
Back
Top