Hi there,

I have been using vba for only a short time, and I am trying to create
a code that will do a handful of things in Outlook; I hope I'm not in
over my head. First, I run a Rule that moves an incoming message
(based on sender) to another Outlook folder; this was easy enough, but
then:

1. If a subdirectory in a network folder does not exist, then create
one based on the date, then
2. Move the attachments in these messages to this dated network folder
subdirectory
3. If the attachments are a specific DisplayName ("PayData"), then
open an Excel workbook ("HrlyPRR.xls").

Voila!

Except, I can only get step 2 working. Step 3 would be the clincher,
while step 1 is more icing than vital; but I simply think I haven't
been immersed in vba long enough to crack this yet.

Here is my code so far (thanks to Sue Mosher for help on this):


Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
Dim myOrt As String
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
Dim myAttachments As Object
Dim myMessage As Object
Set myAttachments = msg.Attachments
Dim v As Variant
Dim s As String

'create subdirectory based on date
x = Year(Date) & " " & Format(Month(Date), "00")
s = "M:\PD\Weekly.Rec"
If Dir(s & "\" & v & "\", vbDirectory) = "" Then
MkDir s & "\" & v & "\"
myOrt = s & "\" & v & "\"
End If

'save attachments to subdirectory
If myAttachments.Count 0 Then
For i = 1 To myAttachments.Count
myAttachments(i).SaveAsFile "myOrt" & _
myAttachments(i).DisplayName

'if attachment name is "PayData.txt" then launch Excel
Set myMessage = Item
With myMessage
If .Attachments.Item.DisplayName = "PayData.txt" Then
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Open("M:\PD\Weekly.Rec\HrlyPRR. xls")
objWB.Activate

End If
End With

Next i
End If

Set msg = Nothing
Set olNS = Nothing

End Sub

Am 17 May 2006 07:05:38 -0700 schrieb :

1) For creating the subdirectory, what is the value of 'v'?

2) You perform the same operation (s & "\" & v & "\" ) three times before
writing that into a variable. Because String operations are time consuming
and in case of a change you´d have to edit all the three terms it would be
better to write the (myOrt = s & "\" & v & "\") as early as possible.

3) If the directory exists already then the variable myOrt remains empty.
That is, the attachments will be saved into any unexpected directory.

4) You call .Attachments.Item without an index. That doesn´t work. Why don´t
you use myAttachments(i), too?

5) If the directory didn´t exist then it can´t contain suddenly an Excel
file in the next step. You could check with the Dir function first whether
or not there´s that file. (And in addition, I suppose if the Excel file is
already opened then it would raise another error if you try to open it
again. That could be checked with the Workbooks.Item property.)

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.vbOffice.net --


Hi there,

I have been using vba for only a short time, and I am trying to create
a code that will do a handful of things in Outlook; I hope I'm not in
over my head. First, I run a Rule that moves an incoming message
(based on sender) to another Outlook folder; this was easy enough, but
then:

1. If a subdirectory in a network folder does not exist, then create
one based on the date, then
2. Move the attachments in these messages to this dated network folder
subdirectory
3. If the attachments are a specific DisplayName ("PayData"), then
open an Excel workbook ("HrlyPRR.xls").

Voila!

Except, I can only get step 2 working. Step 3 would be the clincher,
while step 1 is more icing than vital; but I simply think I haven't
been immersed in vba long enough to crack this yet.

Here is my code so far (thanks to Sue Mosher for help on this):


Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
Dim myOrt As String
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
Dim myAttachments As Object
Dim myMessage As Object
Set myAttachments = msg.Attachments
Dim v As Variant
Dim s As String

'create subdirectory based on date
x = Year(Date) & " " & Format(Month(Date), "00")
s = "M:\PD\Weekly.Rec"
If Dir(s & "\" & v & "\", vbDirectory) = "" Then
MkDir s & "\" & v & "\"
myOrt = s & "\" & v & "\"
End If

'save attachments to subdirectory
If myAttachments.Count 0 Then
For i = 1 To myAttachments.Count
myAttachments(i).SaveAsFile "myOrt" & _
myAttachments(i).DisplayName

'if attachment name is "PayData.txt" then launch Excel
Set myMessage = Item
With myMessage
If .Attachments.Item.DisplayName = "PayData.txt" Then
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Open("M:\PD\Weekly.Rec\HrlyPRR. xls")
objWB.Activate

End If
End With

Next i
End If

Set msg = Nothing
Set olNS = Nothing

End Sub