Outlook Scripts

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I need to automate the following steps for one user account with Outlook
2003. Step one: When a message arrives thats HTML convert to plain text.
Step two: if the message has attachment save those attachments to a
designated network folder. Step three: Print the message. Outlook has this
as an option with rules wizard already. Finial step: Move message to a
different folder after successfully completing all prior steps.

I'm not a programer and I'm just starting to explorer Windows scripting
features as a way to manage and support our network. Has anyone created a
rule or script that can do the above steps?
 
Hi RP,

I haven't try this code maybe this helps.

Sub GetAttachments()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0

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

For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
FileName = "C:\Email Attachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item

If i > 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the C:\Email Attachments folder." _
& vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If

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

GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

End Sub


For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "C:\Email Attachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item


Dim SubFolder As MAPIFolder

Set SubFolder = Inbox.Folders("Sales Reports")

If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the Sales Reports folder." _
, vbInformation, "Nothing Found"
Exit Sub
End If
If SubFolder.Items.Count > 0 Then
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
FileName = "C:\Email Attachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
End If
 
Back
Top