Outlook VBA: Save attachment, open excel, run a macro and resend out as an attachment

[Yogibear88]

Hi, I am still relatively new to VBA coding though have been running files with inbuilt macros. As my knowledge is limited to using existing codes and modifying from there, I hope fellow members in this forum can guide me through my issue below.

I am trying to complete a VBA code in Outook --> to save an excel attachment, open the file, run the script, and then resend out the formatted file.

I tried to do this by activating a script outlook and then calling the module from there. Unfortunately, the code was only able to send out the email but without the attachment, so I cannot determine if the script had worked to format the file.

I know this is an Excel forum but hopefully someone here can help....

++++++++++++++++++++++++++++++++++
'Occurs when new item arrives in Inbox
Private Sub objItems_ItemAdd(ByVal Item As Object)
Debug.Print ("MACRO RUNNING")
Dim objMail As Outlook.MailItem
Dim objWsShell As Object
Dim strTempFolder As String
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Attachment
Dim strFileName As String
Dim databaseFileName As String

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application

If Item.Class = olMail Then
Set objMail = Item
Debug.Print (objMail.SenderEmailAddress)


If objMail.SenderEmailAddress = "yogibear@gmail.com" And objMail.Subject = "Testing_V1" Then
Debug.Print "ACTIVATING CLEANUP"
Debug.Print "INSIDE 1"

Set objWShell = CreateObject("WScript.Shell")
strTempFolder = Environ("Temp") & ""

Set objWsShell = CreateObject("WScript.Shell")
Set objAttachments = objMail.Attachments
If objAttachments.Count > 0 Then
Debug.Print "INSIDE 2"
For Each objAttachment In objAttachments
Debug.Print "INSIDE 3"
strFileName = objAttachment.DisplayName
On Error Resume Next
Kill strTempFolder & strFileName
On Error GoTo 0

'Save the attachment
objAttachment.SaveAsFile strTempFolder & strFileName


'Open the attachment
strFileName = GetShortFileName(strTempFolder & strFileName)
' On Error Resume Next

Call TestChecker(strFileName, xlApp)

xlApp.Quit
Debug.Print "EXCEL CLOSED"
Next
End If
End Sub

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
New module below to be added into Outlook to execute the script in Excel
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub TestChecker(path As String, xlApp As Excel.Application)

xlApp.Workbooks.Open (path)
Debug.Print "ATTACHMENT OPENED"
xlApp.Workbooks(1).Activate
Debug.Print "ATTACHMENT ACTIVATED"
xlApp.WindowState = xlMaximized
Debug.Print "ATTACHMENT MAXIMISED"

'script below should perform the code execution onto the attached file

xlApp.Workbooks(1).Worksheets("page").Range("Y1").FormulaR1C1 = "Automation Check"
xlApp.Workbooks(1).Worksheets("page").Range("Y2").FormulaR1C1 = "Test row 2"
xlApp.Workbooks(1).Worksheets("page").Range("Y3").FormulaR1C1 = "Test row 3"
xlApp.Workbooks(1).Save
Debug.Print "ATTACHMENT SAVED"


Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "donald.duck@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Test case is a success"
.Body = "How Are You Today?"
.Attachments.Add "TEST_FILE.xlsx"
.Send
End With
On Error GoTo 0
Debug.Print "ATTACHMENT SENT OUT"

Set OutMail = Nothing
Set OutApp = Nothing
xlApp.Workbooks(1).Close
Debug.Print "ATTACHMENT CLOSED"


End Sub

 

[DanteAmor]

The only thing I can try is the Excel macro. And the detail I found is that in this line you have another file:

[COLOR=#333333].Attachments.Add "TEST_FILE.xlsx"[/COLOR]

It should be:

.Attachments.Add [COLOR=#0000ff]path[/COLOR]

 

[Yogibear88]

Hi DanteAmor, it works just fine now.....thanks for the valuable tip

 

[DanteAmor]

Hi DanteAmor, it works just fine now.....thanks for the valuable tip

I'm glad to help you. Thanks for the feedback.