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

Is you script delteing the attachments corectly?

I'm just wondering if using "myAttachments.Count" like
myItem.Attachments(myAttachments.Count).SaveAsFile
is working. may be rthe scipt runs before the value is undated.

maybe use somthing like
for i = 1 to myAttachments.Count
instead of
While myAttachments.Count > 0



<s.krantz.fz@xxxxxx> wrote in message
news:5c826172-39fe-4727-a4df-e6de0444d968@xxxxxx

> 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
>
>

I was surprised, too, but this is working correctly for single mails.
But if I have selected more than one mail, the script does only remove
the attachments of the first mail. Maybe timing plays a role. I will
have a look at it again.

Other ideas?

On Jun 13, 6:11 pm, "ThatsIT.net.au" <me@xxxxxx> wrote:

> Is you script delteing the attachments corectly?
>
> I'm just wondering if using "myAttachments.Count" like
> myItem.Attachments(myAttachments.Count).SaveAsFile
> is working. may be rthe scipt runs before the value is undated.
>
> maybe use somthing like
> for i = 1 to myAttachments.Count
> instead of
> While myAttachments.Count > 0
>
> <s.krantz...@xxxxxx> wrote in message
>
> news:5c826172-39fe-4727-a4df-e6de0444d968@xxxxxx