R
Ralf Meuser
Hi there
I try to create a script, which will save attachments from some incomming
mails.
But I'm a small newbee in VB and my script doesn't work.
I got the code from the net and tryed to modifed it, to use it as a script
in outlook 2003 on windows xp.
Thanks in advance for any help
regards
Ralf
here my script
_________________
Sub Test(myItem As MailItem)
'Declaration
Dim myAttachments, myAttachment As Object
Dim myOrt As String
'Dim myOlApp As New Outlook.Application
'Dim myOlExp As Outlook.Explorer
'Dim myOlSel As Outlook.Selection
MsgBox "Mail message arrived:" & myItem.Subject, 1
'# 'Ask for destination folder
'# myOrt = InputBox("Destination", "Save Attachments", "C:\")
myOrt = "C:\tmp\"
'# On Error Resume Next
'# 'work on selected items
'# Set myOlExp = myOlApp.ActiveExplorer
'# Set myOlSel = myOlExp.Selection
'# 'for all items do...
'# For Each myItem In myOlSel
'point on attachments
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'add remark to message text
myItem.Body = myItem.Body & vbCrLf & _
"Removed Attachments:" & vbCrLf
'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
'add name and destination to message text
myItem.Body = myItem.Body & _
"File: " & myOrt & _
myAttachments(i).DisplayName & vbCrLf
Next i
'for all attachments do...
While myAttachments.Count > 0
'remove it (use this method in Outlook XP)
'myAttachments.Remove 1
'# 'remove it (use this method in Outlook 2000)
'# myAttachments(1).Delete
Wend
'save item without attachments
myItem.Save
End If
'# Next
'free variables
Set myAttachments = Nothing
Set myAttachment = Nothing
'Set myOlApp = Nothing
'Set myOlExp = Nothing
'Set myOlSel = Nothing
End Sub
I try to create a script, which will save attachments from some incomming
mails.
But I'm a small newbee in VB and my script doesn't work.
I got the code from the net and tryed to modifed it, to use it as a script
in outlook 2003 on windows xp.
Thanks in advance for any help
regards
Ralf
here my script
_________________
Sub Test(myItem As MailItem)
'Declaration
Dim myAttachments, myAttachment As Object
Dim myOrt As String
'Dim myOlApp As New Outlook.Application
'Dim myOlExp As Outlook.Explorer
'Dim myOlSel As Outlook.Selection
MsgBox "Mail message arrived:" & myItem.Subject, 1
'# 'Ask for destination folder
'# myOrt = InputBox("Destination", "Save Attachments", "C:\")
myOrt = "C:\tmp\"
'# On Error Resume Next
'# 'work on selected items
'# Set myOlExp = myOlApp.ActiveExplorer
'# Set myOlSel = myOlExp.Selection
'# 'for all items do...
'# For Each myItem In myOlSel
'point on attachments
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'add remark to message text
myItem.Body = myItem.Body & vbCrLf & _
"Removed Attachments:" & vbCrLf
'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
'add name and destination to message text
myItem.Body = myItem.Body & _
"File: " & myOrt & _
myAttachments(i).DisplayName & vbCrLf
Next i
'for all attachments do...
While myAttachments.Count > 0
'remove it (use this method in Outlook XP)
'myAttachments.Remove 1
'# 'remove it (use this method in Outlook 2000)
'# myAttachments(1).Delete
Wend
'save item without attachments
myItem.Save
End If
'# Next
'free variables
Set myAttachments = Nothing
Set myAttachment = Nothing
'Set myOlApp = Nothing
'Set myOlExp = Nothing
'Set myOlSel = Nothing
End Sub