Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to locate a new outlook folder
Hi There
I am quite inexperienced using VBA but have managed to put the following piece of code together that nearly does exactly what I need. Basically when I receive an email with a certain subject heading outlook opens a spreadsheet which auto runs this macro to search my inbox for emails with taht subject heading and processes the attachment. My only problem is that I dont want it to search my Inbox I want it to search my sub folder Inbox1. I know this may seem a simple request but I have tried and I have no idea how to do it. Any help would be greatfully appreciated. Thanks in advance Jamie Code: Sub auto_open() Windows("EIS Job Log test.xls").Activate Range("B2").Select Dim olApp As Outlook.Application Dim olNs As NameSpace Dim Fldr As MAPIFolder Dim MoveToFldr As MAPIFolder Dim olMi As MailItem Dim olAtt As Attachment Dim MyPath As String Dim i As Long Set olApp = New Outlook.Application Set olNs = olApp.GetNamespace("MAPI") Set Fldr = olNs.GetDefaultFolder(olFolderInbox) Set MoveToFldr = Fldr.Folders("eisreq") MyPath = "I:\EIS\Forms\EIS Requests\" dattim = Format(Date, "yyyymmdd") & " " & "Time-" & Format(Time, "hhmmss") For i = Fldr.Items.Count To 1 Step -1 Range("A1").Select rowlength = Selection.CurrentRegion.Rows.Count Set olMi = Fldr.Items(i) If InStr(1, olMi.Subject, "EIS_REQUEST") 0 Then For Each olAtt In olMi.Attachments If olAtt.Filename = "EIS Request.xls" Then olAtt.SaveAsFile MyPath & Fldr.Items.Count & " " & olMi.SenderName & " " & "Date-" & dattim & ".xls" open1 = MyPath & Fldr.Items.Count & " " & olMi.SenderName & " " & "Date-" & dattim & ".xls" filenm = Fldr.Items.Count & " " & olMi.SenderName & " " & "Date-" & dattim & ".xls" End If Next olAtt olMi.save olMi.Move MoveToFldr Workbooks.Open Filename:=open1 'copies and pastes data from eis request Range("IR4:IV4").Select Selection.Copy Windows("EIS Job Log test.xls").Activate Range("A1").Select For x = 1 To rowlength If ActiveCell.Cells < "" Then Cells(ActiveCell.Row + 1, 1).Select End If Next x Selection.PasteSpecial paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False 'copies and pastes filename Range("E1").Select For x = 1 To rowlength If ActiveCell.Cells < "" Then Cells(ActiveCell.Row + 1, 6).Select End If Next x ActiveCell = filenm Windows(filenm).Activate ActiveWorkbook.Close False Windows("EIS Job Log test.xls").Activate ActiveWorkbook.save End If Next i ActiveWorkbook.Close False Set olAtt = Nothing Set olMi = Nothing Set Fldr = Nothing Set MoveToFldr = Nothing Set olNs = Nothing Set olApp = Nothing End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
From Outlook to Excel Personal Folder | Excel Worksheet Functions | |||
Outlook attachment to network folder | Excel Discussion (Misc queries) | |||
Outlook Automation Error Problem - Can't locate Outlook Module | Excel Programming | |||
How do I locate the Exploring PowerPoint folder in Word & Excel? | Excel Discussion (Misc queries) | |||
How do I link to an Outlook public folder from an Excel spreadshe. | Excel Discussion (Misc queries) |