Open Only Excel files from Outlook Folder

[hajiali]

Sub InboxToExcel()
    Dim olApp As Object 'Outlook.Application
    Dim olNS As Object 'Outlook.Namespace
    Dim olItems As Object 'Outlook.Items
    Dim olItem As Object 'Outlook.MailItem
    Dim olAttach As Object 'Outlook.Attachment
    Dim Flg As Boolean
    Dim i As Integer
    Dim MT As Long
    Dim Mnth As String
    Dim xWb As Workbook
    Dim xWs As Worksheet
    Dim xRow As Integer
        ActiveSheet.Unprotect Password:="password"
    On Error Resume Next
Set xWb = ActiveWorkbook
Set xWs = ActiveSheet
xRow = 1


On Error Resume Next
MT = InputBox("WHAT MONTH BID DO YOU WANT TO IMPORT? TYPE THE MONTH NUMBER 1-JANUARY..ETC")
Mnth = MonthName(MT)
If MT = 0 Then
Exit Sub
Else

Const olFolderInbox As Long = 6

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
Err.Clear: On Error GoTo 0

If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
Flg = True
End If

Set OutlookApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Folders("Bids").Folders(Mnth).Items
i = 1

For Each olItem In olItems
    If TypeName(olItem) = "MailItem" Then
        If Int(olItem.ReceivedTime) <= Date Then
            On Error Resume Next
            Set olAttach = olItem.Attachments.item(1)
            Err.Clear: On Error GoTo 0
                If Not olAttach Is Nothing Then
                        olAttach.Open
                        olAttach.Range("A1:J73").Copy
                        xWs.Range("Y1").Select
                        xWs.Paste
                        Range("X1").Offset(i, 0).Value = olItem.ReceivedTime
                        Range("X1").Offset(i, 0).Columns.AutoFit
                        Range("X1").Offset(i, 0).VerticalAlignment = xlTop
                        Call EmailCopy
                    End If
                End If
        End If
   
Next
    i = i + 1
   
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = NothingE
Range("X:AH").ClearContents
Call TextToNumbers
Call SelSortRows
Call RemoveBlanks
Range("A1").Select
    MsgBox "ALL ATTACHED FILES WERE COPIED TO EXCEL.", vbOKOnly
End If
End Sub

How would I modify the above code to just Open all attach file in the specific folder without saving the file and then procced with copying.

getting error on

olAttach.Open

any help is greatly appreciated.

 

[Domenic]

You'll need to first save the workbook to some location, such as your temporary folder, and then you can open it from there. Here's an example . . .

    Dim tempFile As String
    Dim currentWorkbook As Workbook
    
    With olAttach
        tempFile = Environ("temp") & "\" & olAttach.Filename
        .SaveAsFile tempFile
        Set currentWorkbook = Workbooks.Open(tempFile)
        'etc
        '
        '
        currentWorkbook.Close SaveChanges:=False
        Kill tempFile
    End With

Hope this helps!

 

[Domenic]

By the way, once you've finished with an attachment, you should set olAttach equal to Nothing . . .

Set olAttach = Nothing

Otherwise, If Not olAttach Is Nothing will evaluate to True, even though the next email contains no attachments.

 

[hajiali]

Thanks for the tip Domenic. I will try that So basically I’m trying to open without saving but bypass to that would be saving it to temp folder and followed?

kill temp

So that will in a way remove the saved file. Because i will be opening over 200 files and do not want them actually saved to any folder.

 

[Domenic]

Yes, the workbook is saved to your temporary folder, then the workbook is opened from there, then you do the necessary copying and pasting, then the workbook is closed without saving it, and then the workbook is deleted.