Open Only Excel files from Outlook Folder

hajiali

Well-known Member
Joined
Sep 8, 2018
Messages
623
Office Version
  1. 2016
Platform
  1. Windows
VBA Code:
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

VBA Code:
olAttach.Open

any help is greatly appreciated.
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
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 . . .

VBA Code:
    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!
 
Upvote 0
Solution
By the way, once you've finished with an attachment, you should set olAttach equal to Nothing . . .

VBA Code:
Set olAttach = Nothing

Otherwise, If Not olAttach Is Nothing will evaluate to True, even though the next email contains no attachments.
 
Upvote 0
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?

VBA Code:
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,986
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top