Email opening and starting Excel

[StefanThie]

Dear all,

I am looking for a vba, that will open the Emails in one specific subfolder in my outlook program. (I saw this is not the issue)
Now I wanted that the attachment an Excel file will be opened and the vba in that excel sheet is started.
Is there a smart solution?
The perfect solution would be then that this will only happen at 21:00 when I am already at home. Also can the vba then distinguish between read and not-read emails?

Cheers

Stefan

[gmayor]

It is possible to create an Outlook macro that will look at all unread messages in a folder and save any excel files that they contain to the hard drive.

I have posted code in this forum on several occasions that demonstrates how to do that.

It should also be possible to open each of those files in Excel, and if they contain an auto-running macro that should run when they are opened, but I foresee problems with that, which could result in a log jam in Excel and that application crashing. What is it that the Excel macro is supposed to do with the attachment?

[StefanThie]

The macro is a kind of a big filter. That is checking for different criteria, sending emails to the responsible guys.
My idea was to open the excel automatic in outlook and call the excel subfunction. So that the system can run during night. I should go through each email step by step with enough time buffer to avoid that the filter will operate on two attachments in parallel.

Cheers

[gmayor]

If the Excel code is the same each time, then if you recreate the Excel function in Outlook VBA and run it from there, rather than from code in the workbook, it should work. The basic code follows. The batch process uses a progress indicator which you can download from http://www.gmayor.com/Zips/ProgressBar.zip. (http://www.gmayor.com/Zips/ProgressBar.zip) There's also a macro to test the code with a selected message. All it needs is the Excel process.


Option Explicit

Sub ProcessAttachment()
'Graham Mayor http://www.gmayor.com
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
SaveAttachments olMsg
lbl_Exit:
Exit Sub
End Sub

Sub ProcessFolder()
'Graham Mayor http://www.gmayor.com
Dim olNS As Outlook.NameSpace
Dim olMailFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olMailItem As Outlook.MailItem
Dim ofrm As New frmProgress
Dim PortionDone As Double
Dim strPath As String
Dim i As Long

On Error GoTo err_Handler
Set olNS = GetNamespace("MAPI")
Set olMailFolder = olNS.PickFolder
Set olItems = olMailFolder.Items
ofrm.Show vbModeless
i = 0
For Each olMailItem In olItems
i = i + 1
PortionDone = i / olItems.Count
ofrm.lblProgress.Width = ofrm.fmeProgress.Width * PortionDone
SaveAttachments olMailItem
DoEvents
Next olMailItem
err_Handler:
Unload ofrm
Set ofrm = Nothing
Set olNS = Nothing
Set olMailFolder = Nothing
Set olItems = Nothing
Set olMailItem = Nothing
lbl_Exit:
Exit Sub
End Sub


Private Sub SaveAttachments(olItem As MailItem)
'Graham Mayor http://www.gmayor.com
Dim olAttach As Attachment
Dim strFname As String
Dim strExt As String
Dim j As Long
Const strSaveFldr As String = "C:\Path\Workbooks\"
CreateFolders strSaveFldr
On Error GoTo CleanUp
If olItem.Attachments.Count > 0 Then
For j = olItem.Attachments.Count To 1 Step -1
Set olAttach = olItem.Attachments(j)
If olAttach.FileName Like ".xlsx" Then
strFname = olAttach.FileName
strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
strFname = FileNameUnique(strSaveFldr, strFname, strExt)
olAttach.SaveAsFile strSaveFldr & strFname
'Open the workbook and process it here
End If
Next j
End If
CleanUp:
Set olAttach = Nothing
Set olItem = Nothing
lbl_Exit:
Exit Sub
End Sub

Private Function FileNameUnique(strPath As String, _
strFileName As String, _
strExtension As String) As String
'Graham Mayor http://www.gmayor.com
Dim lngF As Long
Dim lngName As Long
lngF = 1
lngName = Len(strFileName) - (Len(strExtension) + 1)
strFileName = Left(strFileName, lngName)
Do While FileExists(strPath & strFileName & Chr(46) & strExtension) = True
strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
lngF = lngF + 1
Loop
FileNameUnique = strFileName & Chr(46) & strExtension
lbl_Exit:
Exit Function
End Function

Private Function FileExists(filespec) As Boolean
'Graham Mayor http://www.gmayor.com
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(filespec) Then
FileExists = True
Else
FileExists = False
End If
lbl_Exit:
Exit Function
End Function

Private Function FolderExists(fldr) As Boolean
'An Outlook macro by Graham Mayor
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FolderExists(fldr)) Then
FolderExists = True
Else
FolderExists = False
End If
lbl_Exit:
Exit Function
End Function

Private Function CreateFolders(strPath As String)
'Graham Mayor http://www.gmayor.com
Dim strTempPath As String
Dim lngPath As Long
Dim vPath As Variant
vPath = Split(strPath, "\")
strPath = vPath(0) & "\"
For lngPath = 1 To UBound(vPath)
strPath = strPath & vPath(lngPath) & "\"
If Not FolderExists(strPath) Then MkDir strPath
Next lngPath
lbl_Exit:
Exit Function
End Function

[StefanThie]

How to implement the progress indicator.
Macro is creating the folder on my drive but nothing is stored
Cheers
Stefan

[gmayor]

Download the progress indicator - extract the two files from the zip and import the frm file into the VBA editor.
The macro only extracts xlsx format files.

The line

If olAttach.FileName Like ".xlsx" Then should read
If olAttach.FileName Like "*.xlsx" Then or
If olAttach.FileName Like "*.xl*" Then