Outlook macro to modify email attachment using Excel

[bigbuckaroo]

Greetings all,

I have an ongoing project where I am gathering data from an application and using VBA to send myself an email with an attachment.

In Outlook I am trying to set up a rule where I run an Excel macro on the attachment so I have attempted to piece together some code from numerous searches. I have a rule set up to "run script" when an incoming email has "Count Log" as its subject.

Here is the code I have in Outlook:

Sub script_rule(mymail As MailItem)
 Dim strID As String
    Dim olNS As Outlook.NameSpace
    Dim olMail As Outlook.MailItem
    
    strID = mymail.EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set olMail = olNS.GetItemFromID(strID)
    ' do stuff with olMail, e.g.
  

Excel.Application.Run

Run Personal.XLSB("Modify_Count_Log")
   
    Set olMail = Nothing
    Set olNS = Nothing

End Sub

I think I have the Outlook rule set right as it points to the above name "script" in the rule.

I am trying to run the macro entitled "Modify_Count_Log" in Excel but it never runs. This macro was created using the record macro function in Excel and will work if I open the email attachment and then run the macro from there. Basically the macro modifys column widths and deletes others and then saves the modified file to a folder on my computer. Can someone take a look and please advise as to where the problem is?

Thanks alot for any suggestions.

Tom

 

[bigbuckaroo]

Well,

I have done some more digging and modified my program as follows:

Sub script_rule(mymail As MailItem)
 Dim strID As String
    Dim olNS As Outlook.NameSpace
    Dim olMail As Outlook.MailItem
    
    strID = mymail.EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set olMail = olNS.GetItemFromID(strID)
    ' do stuff with olMail, e.g.
     ' open wkbk and run import macro
     
   Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim XLApp As Object ' Excel.Application
   Dim XlWK As Object ' Excel.Workbook
   Dim Att As String
        
    Const attPath As String = "C:\Users\xxxx\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\HALAKEVW\2010 10 19 0000 (Wide).DBF"
 
  ' New Excel.Application
   Set XLApp = CreateObject("Excel.Application")
 On Error Resume Next
    XLApp.Workbooks.Open _
 ("C:\Users\xxxxx\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
       
    ' open workbook and run macro
   XLApp.Workbooks.Open (attPath & Att)
 XLApp.Run ("PERSONAL.XLSB!Modify_Count_Log")

   XLApp.Workbooks.Close
    Kill attPath & Att
    XLApp.Quit

     Set olMail = Nothing
    Set olNS = Nothing

End Sub

It now will take the the email attachment, execute the macro and save it.

Can anyone see any issues with the above?

One thing I still can not figure out though is in the above code the name is this: "2010 10 19 0000" today which is obviously the date. How can I change this so it updates dynamicly? I have tried inserting format(date, "yyyy mm dd") in its place but I get an error that says expected end of statement at the yyyy. Anyone have an idea as to what to do about this?

Again any help is greatly appereciated.

Thanks

Tom

 

[PHV]

Replace this:
Const attPath As String = "C:\Users\xxxx\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\HALAKEVW\2010 10 19 0000 (Wide).DBF"
with this:
Dim attPath As String
attPath = "C:\Users\xxxx\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\HALAKEVW\" & Format(Date, "yyyy mm dd") & " 0000 (Wide).DBF"

I didn't see in your code where Att was assigned a value.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[fumei]

Or use format(date, "yyyy mm dd") to set a string variable, then use the variable in the filename.

attPath appears to be a full path and filename. What is Att? As PHV states, it is not declared nor given a value.


unknown

 

[bigbuckaroo]

First off, thanks for the replies. I will do as suggested and insert the "format(date,....) and give it a try. As for your questions, I will have to give it some more attention. I pieced together this code from various searches so I am not exactly sure what all is going on with it. I have other pressing concerns today so may no be able to revisist this untill tomorrow. Again thanks for the help.

Tom

 

[bigbuckaroo]

There was a bit of code that I inadvertently left out.

Set myAttachments = item.Attachments
    Att = myAttachments.item(1).DisplayName
    myAttachments.item(1).SaveAsFile attPath & Att

It is now inserted into my code.

I did as suggested and put in this line of code:

attPath = "C:\Users\xxxx\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\HALAKEVW\" & Format(Date, "yyyy mm dd") & " 0000 (Wide).DBF"

However when I send an email to initiate the code I get a compile error "constant expression required" and the Format(date...... is hilighted.

Any suggestions?

Thanks

Tom

 

[PHV]

Did you get rid of Const attPath ...?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[bigbuckaroo]

No I did not get rid of that line of code. Let me go back and go over what I am trying to accomplish and then maybe it will be easier for everyone to offer suggestions.

I have a remote computer that generates 2 files every night. I am only concerned with one right now as I figure if I get one working then I can copy to the next.

The file gets sent to my work email address where "Count Log" is in the subject line and an attachment is included. The attachment name is "2010 10 19 0000 (Wide).DBF" without the quotes. The first 3 groups of numbers represent the date it was created and obviously changes daily.

I have a macro in the Personal workbook to modify the attachment. It adds headers and deletes unneeded information from the file.

In Outlook I am trying to "run script" from a rule that checks for the subject and then does the Excel macro.

The line of code where I have const attpath I am assuming is pointing to where the email attachment is. Correct? If it is not needed then how would I set the code up to run every time the new email with attachment arrives?

I apologise if I am making little sense as I am new to the world of VBA and most of this is rather confusing.

I will remmove that line of code and check on the results.

Thanks

Tom

 

[bigbuckaroo]

I removed the following line of code as suggested:

 Const attPath As String = "C:\Users\xxxx\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\HALAKEVW\2010 10 19 0000 (Wide).DBF"

and ran it to check results.

The process created and saved an Excel file with today's date and the headers and resized columns but none of the information from the email attachment was inserted into it.

Thanks

Tom

 

[PHV]

Heve you put the 2 lines I've suggested (19 Oct 10 14:42) in lieu of the removed line ?

 

[bigbuckaroo]

PHV Thank you so much for your patience and help. I went back and reread the post you suggested and found I did not put this line in my code:

Dim attPath As String

When I put the other line in and tried it that is when it generated the compile error. With the edition of the missed line it now appears to be working when I tried it.


Another question I have is this:

What happens if more then 1 email is recieved with the target subject line? For example Monday there would be 3 emails recieved, taking into account the weekend. Will it process multiple emails in order recieved with out issue or will I have to modify my code to take that into consideration? With a loop of some kind maybe? I am thinking that my code is only ran when I open Outlook and the emails are recieved.

Again thanks for your help.

 

[bigbuckaroo]

So this morning I open Outlook and today's email is recieved into the folder I have it sent to. However, when I check the folder where the "modifed by macro" file is to be, I have a file with the stuff done from the macro but not the information that is supposed to come from the email attachment.

Sub script_rule(mymail As MailItem)
 Dim strID As String
    Dim olNS As Outlook.NameSpace
    Dim olMail As Outlook.MailItem
    
    strID = mymail.EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set olMail = olNS.GetItemFromID(strID)
    ' do stuff with olMail, e.g.
     ' open wkbk and run import macro
     
   Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim XLApp As Object ' Excel.Application
   Dim XlWK As Object ' Excel.Workbook
   Dim Att As String
    Dim attPath As String
    attPath = "C:\Users\xxxxx\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\HALAKEVW\" & Format(Date, "yyyy mm dd") & " 0000 (Wide).DBF"
 
  ' New Excel.Application
   Set XLApp = CreateObject("Excel.Application")
 On Error Resume Next
    XLApp.Workbooks.Open _
 ("C:\Users\xxxxx\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
 
 Set myAttachments = item.Attachments
    Att = myAttachments.item(1).DisplayName
    myAttachments.item(1).SaveAsFile attPath & Att

       
    ' open workbook and run macro
   XLApp.Workbooks.Open (attPath & Att)
 XLApp.Run ("PERSONAL.XLSB!Modify_Count_Log")

   XLApp.Workbooks.Close
    Kill attPath & Att
    XLApp.Quit

     Set olMail = Nothing
    Set olNS = Nothing

End Sub

In case it is relevant here is the code in the Excel macro:

Sub Modify_Count_Log()
'
' Modify_Count_Log Macro
'

'
    Columns("A:A").ColumnWidth = 8.71
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft
    Columns("O:O").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.RowHeight = 40
    Range("C1").Select
    ActiveCell.FormulaR1C1 = ""
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
    Selection.ColumnWidth = 20
   
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "PINT MACHINE CUP COUNT"
    Columns("D:D").Select
    
    Selection.ColumnWidth = 20
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "TRI TRAY PACKAGE COUNT"
    Columns("E:E").Select
    Selection.ColumnWidth = 20
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE EXTRACTOR CYCLE COUNT"
    Columns("F:F").Select
    Selection.ColumnWidth = 20
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE FILL CYCLE COUNT"
    Columns("G:G").Select
    Selection.ColumnWidth = 20
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE MACHINE CYCLE COUNT"
    Columns("H:H").Select
    Selection.ColumnWidth = 20
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE WRAPPER CYCLE COUNT"
    Columns("I:I").Select
    Selection.ColumnWidth = 20
    ActiveWindow.SmallScroll Down:=-6
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE HOUR METER"
    Columns("J:J").Select
    ActiveWindow.SmallScroll ToRight:=0
    Cells.Select
    ActiveWindow.SmallScroll ToRight:=6
    Columns("J:J").Select
    Selection.ColumnWidth = 20
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER CARTONS GLUED"
    Columns("K:K").Select
    Selection.ColumnWidth = 20
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER CARTONS LOADED"
    Columns("L:L").Select
    Selection.ColumnWidth = 20
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER CARTONS PULLED"
    Columns("M:M").Select
    Selection.ColumnWidth = 20
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER HOUR METER"
    Columns("N:N").Select
    Selection.ColumnWidth = 20
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER MACHINE CYCLES"
    Columns("O:O").Select
    ActiveWorkbook.SaveAs filename:= _
        "C:\production counts\" & Format(Date, "yyyy mm dd") & " 0000 (Wide).xlsm", FileFormat _
        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Any idea as to why it will run the macro but not do it on the email attachment when it is recieved?

Thanks

Tom

 

[bigbuckaroo]

I have finally had time to get back to this. The code posted above is still in use. I recieve the email daily but when the macro runs to modify the attachment, it basically creates another sheet and does the macro on it by placing the headers etc, it does not do it on the email attachment. I have a weeks worth of Excel sheets saved with just headers and no data from the email attachment. Can someone nudge me in the right direction?

If any more information is needed please let me know as I greatly appereciate all the help I have gotten so far.

Thanks

Tom

 

[bigbuckaroo]

Curious, have I done something wrong? Offended someone maybe? Wondering why I have not recieved any responses to my issue. If there is something I did wrong or need to do please let me know and I will correct it. If the solution to my problem above seems obvious to others can you explain? This is a learn as I go approach so any help I recieve is greatly apperciated

Thanks

Tom

 

[SkipVought]

Give this a try...

Sub Modify_Count_Log()
'
' Modify_Count_Log Macro
'

'[b]
    Dim wb As Workbook
    
    For Each wb In Workbooks
        If wb.Name <> "PERSONAL.XLSB" Then
            wb.Activate
        End If
    Next
'[/b]
    Columns("A:A").ColumnWidth = 8.71
    Columns("C:O").Delete Shift:=xlToLeft
    Rows("1:1").RowHeight = 40
    
    With Rows("1:1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .EntireColumn
    End With
   
    Columns("C:C").ColumnWidth = 20
    Range("C1").Value = "PINT MACHINE CUP COUNT"
    
    Columns("D:D").ColumnWidth = 20
    Range("D1").Value = "TRI TRAY PACKAGE COUNT"
    
    Columns("E:E").ColumnWidth = 20
    Range("E1").Value = "8 WIDE EXTRACTOR CYCLE COUNT"
    
    Columns("F:F").ColumnWidth = 20
    Range("F1").Value = "8 WIDE FILL CYCLE COUNT"
    
    Columns("G:G").ColumnWidth = 20
    Range("G1").Value = "8 WIDE MACHINE CYCLE COUNT"
    
    Columns("H:H").ColumnWidth = 20
    Range("H1").Value = "8 WIDE WRAPPER CYCLE COUNT"
    
    Columns("I:I").ColumnWidth = 20
    Range("I1").Value = "8 WIDE HOUR METER"
    
    Columns("J:J").ColumnWidth = 20
    Range("J1").Value = "HOY PAK BOXER CARTONS GLUED"
    
    Columns("K:K").ColumnWidth = 20
    Range("K1").Value = "HOY PAK BOXER CARTONS LOADED"
    
    Columns("L:L").ColumnWidth = 20
    Range("L1").Value = "HOY PAK BOXER CARTONS PULLED"
    
    Columns("M:M").ColumnWidth = 20
    Range("M1").Value = "HOY PAK BOXER HOUR METER"
    
    Columns("N:N").ColumnWidth = 20
    Range("N1").Value = "HOY PAK BOXER MACHINE CYCLES"
    
    ActiveWorkbook.SaveAs _
        Filename:="C:\production counts\" & Format(Date, "yyyy mm dd") & " 0000 (Wide).xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
        CreateBackup:=False
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[bigbuckaroo]

Thanks for the reply. I will give it a try and report back.

Tom

 

[bigbuckaroo]

I seriously apologize for not being able to figure this out. I copied and pasted your suggestions to my Excel macro so now it looks like this

Sub Modify_Count_Log()
'
' Modify_Count_Log Macro

Dim wb As Workbook
 For Each wb In Workbooks
  If wb.Name <> "Personal.XLSB" Then
   wb.Activate
    End If
Next

'
    Columns("A:A").ColumnWidth = 8.71
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft
    Columns("O:O").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.RowHeight = 40
    Range("C1").Select
    ActiveCell.FormulaR1C1 = ""
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
    Selection.ColumnWidth = 20
   
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "PINT MACHINE CUP COUNT"
    Columns("D:D").Select
    
    Selection.ColumnWidth = 20
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "TRI TRAY PACKAGE COUNT"
    Columns("E:E").Select
    Selection.ColumnWidth = 20
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE EXTRACTOR CYCLE COUNT"
    Columns("F:F").Select
    Selection.ColumnWidth = 20
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE FILL CYCLE COUNT"
    Columns("G:G").Select
    Selection.ColumnWidth = 20
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE MACHINE CYCLE COUNT"
    Columns("H:H").Select
    Selection.ColumnWidth = 20
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE WRAPPER CYCLE COUNT"
    Columns("I:I").Select
    Selection.ColumnWidth = 20
    ActiveWindow.SmallScroll Down:=-6
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "8 WIDE HOUR METER"
    Columns("J:J").Select
    ActiveWindow.SmallScroll ToRight:=0
    Cells.Select
    ActiveWindow.SmallScroll ToRight:=6
    Columns("J:J").Select
    Selection.ColumnWidth = 20
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER CARTONS GLUED"
    Columns("K:K").Select
    Selection.ColumnWidth = 20
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER CARTONS LOADED"
    Columns("L:L").Select
    Selection.ColumnWidth = 20
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER CARTONS PULLED"
    Columns("M:M").Select
    Selection.ColumnWidth = 20
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER HOUR METER"
    Columns("N:N").Select
    Selection.ColumnWidth = 20
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "HOY PAK BOXER MACHINE CYCLES"
    Columns("O:O").Select
    
   
      ActiveWorkbook.SaveAs _
      filename:="C:\production counts\" & Format(Date, "yyyy mm dd") & " 0000 (Wide).xlsm", _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
     CreateBackup:=False
End Sub

And I have this as the script rule in Outlook under the My Outlook Session:

Sub Process_Count_Log(mymail As MailItem)

Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem

strID = mymail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
' do stuff with olMail, e.g.
' open wkbk and run import macro

Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim XLApp As Object ' Excel.Application
Dim XlWK As Object ' Excel.Workbook
Dim Att As String
Dim attPath As String
attPath = "C:\Users\xxxxx\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\HALAKEVW\" & Format(Date, "yyyy mm dd") & " 0000 (Wide).DBF"

' New Excel.Application
Set XLApp = CreateObject("Excel.Application")
On Error Resume Next
XLApp.Workbooks.Open _
("C:\Users\xxxxx\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB")

Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att


' open workbook and run macro
XLApp.Workbooks.Open (attPath & Att)
XLApp.Run ("PERSONAL.XLSB!Modify_Count_Log")

XLApp.Workbooks.Close
Kill attPath & Att
XLApp.Quit

Set olMail = Nothing
Set olNS = Nothing

End Sub

In my program "xxxx" is replaced with my username.When I open Outlook I get my incoming email but when I go to the folder where the modifed file should be again all that is there is the stuff done by the Excel macro, not the information from the recieved email. I do not know if I have fat fingers and hit a wrong key or what. I have tried looking over it and can't seem to figure out what is going on.

Any ideas or suggestions?

Thanks
Tom