Saving attachments automatically

Hi all,

I've written an outlook script to save all attachments automatically
to some folder. Unfortunately this script is not working correctly. If
I select a lot of mails with attachments, it saves only the
attachments of the first mail.

I've tried to debug the script: the script runs through all selected
mails and there attachments correctly, but they are not saved. Does
anyone see my error? This would be great.

Thanks in advance, Stephan
-------------------------------------
Sub SaveAttachment()

'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt, myDate, destination As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
myOrt = "H:\documents\attachments\"


'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel
'if there are some...
Set myAttachments = myItem.Attachments
nrOfAttachments = myAttachments.Count
While myAttachments.Count > 0
'save them to destination
myDate = Format(myItem.CreationTime, "yyyy-mm-dd")
If Not fso.FolderExists(myOrt & myDate & "\") Then
fso.CreateFolder (myOrt & myDate & "\")
End If
destination = myOrt & _
myDate & "\" & _
myItem.Attachments(myAttachments.Count).DisplayName
myItem.Attachments(myAttachments.Count).SaveAsFile
destination
If Err.Number = 0 Then
myItem.Attachments(myAttachments.Count).Delete
myItem.Body = "Removed Attachment: " & destination &
vbCrLf & _

"--------------------------------------------------------------------"
& vbCrLf & _
myItem.Body
Else
MsgBox Err.Description
End If
'add name and destination to message text
Wend
Next
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub


.

Relevant Pages

  • Re: Saving attachments automatically
    ... I've written an outlook script to save all attachments automatically ... Dim myOrt, myDate, destination As String ... Set myAttachments = Nothing ...
    (microsoft.public.scripting.vbscript)
  • Scripting: Zipping files and checking Network Share
    ... I am trying to write a script that performs a few specific ... Copy source files to destination only if they do not exsist on the ... out how to have it loop until a successful connection is made - and send out ... Sub CopySource() ...
    (microsoft.public.scripting.vbscript)
  • Re: Scripting: Zipping files and checking Network Share
    ... I am trying to write a script that performs a few specific ... Copy source files to destination only if they do not exsist on the ... out how to have it loop until a successful connection is made - and send ... Sub CopySource() ...
    (microsoft.public.scripting.vbscript)
  • Re: How to save attachment automatically in Outlook 2003?
    ... very helpful and the script works very well. ... Dim myOlApp As Outlook.Application ... Set msg = Nothing ... These samples show various ways to save attachments that you could ...
    (microsoft.public.outlook.program_vba)
  • Spam stopper. (Was Re: "ABC Consumer Reports" doesnt recommend Linux)
    ... I just had a look at your spam stopping script, which is a little bit like ... Please don't send me html mail or un-notified attachments. ...
    (comp.os.linux.misc)