Hello,

I put this same question in the Ozgrid forums but they can't seem to
help...
http://www.ozgrid.com/forum/showthread.php?t=147301

I currently have working code to import data from CSV files within a
folder on a shared drive.
The code finds a file based on its name and copies from the second row
down to the last used row and pastes it into the current workbook, in
a sheet of the same name as the file. All futher files found with the
same name are then placed underneath the previous data.

I need to convert this code to import from an Outlook Public Folder
instead but am completely new to Outlook programming and am at a loss
how to do this effectively.

I have recently learned (thanks to Ken Slovak) that the files in
Outlook are not classed as email items but Outlook.DocumentItem
objects (IPM.Document.Excel.Sheet.8)
I'd also like to slot the "Application.Session.PickFolder()" method in
there to allow the user to select which outlook folder is used but I
am unsure if this is possible through Excel!

Any help is much appreciated!

Sub ImportAirport()
Application.DisplayAlerts = False
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Dim LastRow As Long
Application.ScreenUpdating = False
With Application.FileSearch
..NewSearch

On Error GoTo Cancelled

Dim strCell As String

..LookIn = Worksheets("Main").Range("D11")
' ("Please amend the folder name as appropriate using the following
format as an example" _
' & Chr(13) & Chr(13) & "F:\APRD SHARED FOLDER\", "Enter File Path",
strCell)

If .LookIn = "" Then GoTo EmptyResp

On Error GoTo 0

..Filename = "*Airport*.csv"
..MatchTextExactly = False

..FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set basebook = ThisWorkbook
rnum = 2
For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))
Application.AskToUpdateLinks = False
'Define the SourceRange
With mybook.Worksheets(1)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'Now you know where the list (to be copied) ends
Set sourceRange = .Range("A2", "A" & LastRow).EntireRow 'Sets the
range to copy.

End With
'Define where to put the source values
With basebook.Worksheets("Airport")
'Establish the last used row in the target ws
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'Copy the whole lot over starting from row that's =lastRow + 1
sourceRange.Copy Destination:=.Cells(LastRow + 1, "A")
End With

mybook.Close SaveChanges:=False
rnum = i * a + 1
Next i
End If
End With
Call ImportExams
Call ImportIntlTrade
Call ImportMail
Call ImportMaritime
Call ImportRail
Call ImportScanning
Call ImportSummary

'Delete unused cells for easy access import
Call DeleteUnused

Exit Sub
Cancelled:
Exit Sub
EmptyResp:
MsgBox ("No file path selected." & Chr(13) & Chr(13) & _
"Please re-enter the file path and try again"), , ("File Path
Missing")
End Sub