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. 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