Saving attachments to folder from public folder

[Andy]

Hey there!

I'm currently working on a project that involves merging data from
many different csv files into one Excel workbook for analysis.
The csv files are sent to a public folder (outlook:\\Public Folders
\All Public Folders\etc...)

I thought the easiest way to do this would be to import the data
straight from Outlook to the Excel file but after much painful testing
I couldn't get it to work so I will settle for a way to copy the files
from the public folder to my H drive.

I have code to do this but it only seems to work on my main mailbox
folders, not public and am unsure why... I have almost no experience
with Outlook coding so any help is appreciated!

This is the current code:
If there is a way to input which public folder is copied from instead
of using a selection, that's fine too!

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String



' Get the path to your My Documents folder
strFolderpath = "H:\Merge Tool\Import from Outlook\"
On Error Resume Next

If MsgBox("Are you sure?", vbYesNo, "Copying files") = vbNo Then
Exit Sub

Else

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Check each selected item for attachments. If attachments exist,
' save them to the Temp folder and strip them from the item.
For Each objMsg In objSelection

' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count

'Use the MsgBox command to troubleshoot. Remove it from the final
code.
' MsgBox objAttachments.Count

If lngCount > 0 Then

' We need to use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.

For i = lngCount To 1 Step -1

' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.Item(i).FileName

' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile

' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile

' Delete the attachment. Commented out for testing purposes
' objAttachments.Item(i).Delete
' objMsg.Delete

Next i
End If

Next

End If

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

[Ken Slovak]

Where is this code running? Is it running in the Outlook VBA project or
what? If it's running in the Outlook VBA project do not instantiate a new
Outlook.Application object, use the intrinsic Application object instead.

The code is depending on selection of items in the folder of interest. Is
that what you want? You'd need to select the public folder and then select
the items where you want to work with the attachments.

If you want to provide for user selection of the folder you can use the
NameSpace.PickFolder() method:

Dim oFolder As Outlook.MAPIFolder
Set oFolder = Application.Session.PickFolder()

For Each objMsg In oFolder.Items
'etc.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
Hey there!
I'm currently working on a project that involves merging data from
many different csv files into one Excel workbook for analysis.
The csv files are sent to a public folder (outlook:\\Public Folders
\All Public Folders\etc...)
I thought the easiest way to do this would be to import the data
straight from Outlook to the Excel file but after much painful testing
I couldn't get it to work so I will settle for a way to copy the files
from the public folder to my H drive.
I have code to do this but it only seems to work on my main mailbox
folders, not public and am unsure why... I have almost no experience
with Outlook coding so any help is appreciated!
If there is a way to input which public folder is copied from instead
of using a selection, that's fine too!
Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
' Get the path to your My Documents folder
strFolderpath = "H:\Merge Tool\Import from Outlook\"
On Error Resume Next
If MsgBox("Are you sure?", vbYesNo, "Copying files") = vbNo Then
Exit Sub
Else
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
' Check each selected item for attachments. If attachments exist,
' save them to the Temp folder and strip them from the item.
For Each objMsg In objSelection
' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
'Use the MsgBox command to troubleshoot. Remove it from the final
code.
' MsgBox objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.Item(i).FileName
' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
' Delete the attachment. Commented out for testing purposes
' objAttachments.Item(i).Delete
' objMsg.Delete
Next i
End If
Next
End If
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

[Andy]

Hi Ken, thanks for the reply!

Yes, the code is running through a module in the Outlook VBA project -
as for the intrinsic Application object, I'm not entirely sure what
you mean!

As for the rest of the code - brilliant tip! Being able to select the
folder itself is very useful, however the macro still doesn't appear
to do anything - could it be related to your first point?

Grateful for any further help.

Andy.

[Andy]

I managed to get it working once but it copied the wrong folder and
now won't do anything!

Updated code is below incase I did something wrong...

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Get the path to your My Documents folder
strFolderpath = "H:\Merge Tool\Import from Outlook\"
On Error Resume Next

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
' Set objSelection = objOL.ActiveExplorer.Selection

Dim oFolder As Outlook.MAPIFolder
Set oFolder = Application.Session.PickFolder()

'If MsgBox("Are you sure?", vbYesNo, "Copying files") = vbNo Then
'Exit Sub
'
'Else

' Check each selected item for attachments. If attachments exist,
' save them to the Temp folder and strip them from the item.
For Each objMsg In oFolder.Items

' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count

'Use the MsgBox command to troubleshoot. Remove it from the final
code.
' MsgBox objAttachments.Count

If lngCount > 0 Then

' We need to use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.

For i = lngCount To 1 Step -1

' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.Item(i).FileName

' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile

' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile

' Delete the attachment.
' objAttachments.Item(i).Delete
' objMsg.Delete

Next i
End If

Next

' End If

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

[Andy]

Sorry for the multiple posts but I realised what was wrong.
The code:

For Each objMsg In oFolder.Items
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count

takes attachments only from messages, and the folder only contains the
csv files, not attached to messages...

I'm really not sure what to change the code to but I'll keep testing.

[Ken Slovak]

Instead of this:

Set objOL = CreateObject("Outlook.Application")

Use this:

Set objOL = Application

That uses the intrinsic Application object.

I don't see anything wrong with the rest of the code.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
I managed to get it working once but it copied the wrong folder and
now won't do anything!
Updated code is below incase I did something wrong...
Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
' Get the path to your My Documents folder
strFolderpath = "H:\Merge Tool\Import from Outlook\"
On Error Resume Next
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
' Set objSelection = objOL.ActiveExplorer.Selection
Dim oFolder As Outlook.MAPIFolder
Set oFolder = Application.Session.PickFolder()
'If MsgBox("Are you sure?", vbYesNo, "Copying files") = vbNo Then
'Exit Sub
'
'Else
' Check each selected item for attachments. If attachments exist,
' save them to the Temp folder and strip them from the item.
For Each objMsg In oFolder.Items
' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
'Use the MsgBox command to troubleshoot. Remove it from the final
code.
' MsgBox objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.Item(i).FileName
' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
' Delete the attachment.
' objAttachments.Item(i).Delete
' objMsg.Delete
Next i
End If
Next
' End If
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

[Andy]

Thanks Ken - but I still haven't been able to pull the data I want
from the public folder.

The files sent to the folder are not contained within a message, they
are just placed in the folder as a csv file so the code doesn't seem
to read the files as attachments.

I know the code works because I put a message with an attachment in
the folder and it handled it correctly, but it ignored everything
else.

Is there a way to fix this?

[Ken Slovak]

Why would anyone use a public folder as a repository for CSV files? That
makes no sense at all. You'd be far better off just using a network share or
something like SharePoint.

So how are the files being added to the folder then? In what form are they
being stored there? Are they stored as DocumentItem objects?

They must be there as some sort of Outlook object type. The code you're
using would never work if the objects aren't attachments on Outlook items,
as you've discovered.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
Thanks Ken - but I still haven't been able to pull the data I want
from the public folder.
The files sent to the folder are not contained within a message, they
are just placed in the folder as a csv file so the code doesn't seem
to read the files as attachments.
I know the code works because I put a message with an attachment in
the folder and it handled it correctly, but it ignored everything
else.
Is there a way to fix this?

[Andy]

I'm not explaining the system too well, as I am not entirely sure how
it works myself - hence me being here.

The CSV files are sent by other users via outlook to a Returns inbox.
I'm not entirely sure how Outlook public folders work but when I open
the folder it lists all of the CSV files. When I open one Outlook
shows the message:

(Heading) - "Opening Mail Attachment"

(Main Text) - "Attachment: Examination.csv from Returns - Microsoft
Outlook"

So it looks like I was wrong and it is an attachment but the code
still won't copy the file unless it is in a message!

[Ken Slovak]

Outlook folders don't have attachments. Only items can have attachments.

I can't help unless I know what I'm helping with, and at this point I don't
have a clue. Select one of the items in the public folder and run this
macro:

Sub WhatIsThis()
Dim obj As Object
Set obj = Application.ActiveExplorer.Selection(1)
MsgBox obj.MessageClass
End Sub

Open the Outlook VBA project (Alt+F11) and put the macro code in the
ThisOutlookSession class module. Make sure you can run macros, check the
settings for that. To run the macro open the VBA project after selecting an
item in the folder and click F5. Report back what MessageClass the item has.

Do that a few times to make sure the items all have that MessageClass. Once
we have an idea of what we're working with we can proceed.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
I'm not explaining the system too well, as I am not entirely sure how
it works myself - hence me being here.
The CSV files are sent by other users via outlook to a Returns inbox.
I'm not entirely sure how Outlook public folders work but when I open
the folder it lists all of the CSV files. When I open one Outlook
(Heading) - "Opening Mail Attachment"
(Main Text) - "Attachment: Examination.csv from Returns - Microsoft
Outlook"
So it looks like I was wrong and it is an attachment but the code
still won't copy the file unless it is in a message!

[Andy]

"IPM.Document.Excel.Sheet.8"

When I run it in my personal inbox on a message with an Excel file
attached it shows "IPM.Note"

[Ken Slovak]

So what you have then are Outlook.DocumentItem objects and not email items
("IPM.Note"). You need to access the items using that type of object.

A DocumentItem has pretty much the same exposed properties as a MailItem.
Either the actual meat is in an attachment on that object or the object has
the contents in the Body or HTMLBody.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
"IPM.Document.Excel.Sheet.8"
When I run it in my personal inbox on a message with an Excel file
attached it shows "IPM.Note"

[Andy]

Thanks a lot Ken, it works perfectly!

I suppose it would be a lot more complicated to duplicate the code
within Excel?

I have an import process set up in an excel file but it only works
when importing from folders - as you can see I'm not very competent
with Outlook coding.

If I could duplicate the code I have above to work through Excel I
could probably modify it to automate the import process without
needlessly needing to access folders.

Thanks again for the help!

[Ken Slovak]

Running the code from Excel would require a change in the instantiation of
the Outlook.Application object, plus it might involve security aspects.

Instead of an intrinsic Outlook.Application object, in Excel the intrinsic
Application object is Excel.Application. So you'd need to create an Outlook
object if none existed or grab an existing one:

Dim oOL As Outlook.Application

Set oOL = GetObject(, "Outlook.Application")
If (oOL Is Nothing) Then
Set oOL = CreateObject("Outlook.Application")
End If

Outside code automating Outlook might be subject to the Outlook object model
guard security depending on the Outlook version. If it's 2007 or 2010 then
you should be OK as long as you have up-to-date anti-virus software running.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
Thanks a lot Ken, it works perfectly!
I suppose it would be a lot more complicated to duplicate the code
within Excel?
I have an import process set up in an excel file but it only works
when importing from folders - as you can see I'm not very competent
with Outlook coding.
If I could duplicate the code I have above to work through Excel I
could probably modify it to automate the import process without
needlessly needing to access folders.
Thanks again for the help!

[Andy]

We have other systems that allow the use of Outlook through them so it
shouldn't be an issue. Some show a pop up asking to allow it or not
but that won't bother us at all.

So technically another similar piece of code I've been struggling with
should be able to work using some of your code:

It's a little more complicated - It copies the data from the CSV files
in a folder and pastes it in the same sheet within the current
workbook. It all works perfectly ok from the folder on a shared drive
but I can't seem to convert it properly for Outlook.

Maybe with your tips I can try to adapt it with more success!

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")

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

[Andy]

I don't appear to be having much luck converting the code - any chance
you could help me out one last time?

Many thanks.

[Ken Slovak]

Convert what? The last code you showed didn't seem to have anything Outlook
in it, it was all Excel code.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
I don't appear to be having much luck converting the code - any chance
you could help me out one last time?
Many thanks.

[Andy]

That's exactly the problem!

The code is from an excel workbook that imports data from a folder but
I need to change it to import from an Outlook folder instead, similar
to your previous solution. I am struggling to put the two together.

[Ken Slovak]

Excel workbook code has nothing to do with Outlook coding, I don't
understand what you are asking. I already showed you how to modify the code
to run from Excel instead of running in the Outlook VBA project.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
That's exactly the problem!
The code is from an excel workbook that imports data from a folder but
I need to change it to import from an Outlook folder instead, similar
to your previous solution. I am struggling to put the two together.

[Andy]

The code I last posted is actually different from my original code and
I am finding it hard to finish it. I've tried using your code to fix
it but it isn't as simple as the previous issue.

The original was only to move files from Outlook to a folder in a
shared drive. That's fine and sorted but I'm now trying to fix a
similar issue but with more steps in the process, and that is where my
problem is.

The code is in Excel itself but I need to modify it to work with
Outlook.

Currently it imports data from CSV files and pastes it into Excel
which works fine - all I need to do is change it to pull the data from
Outlook instead of the shared drive.

I guess the simple explanation for what I'm asking is that I already
have almost working code, and you have explained very well how to
modify the code but I am having trouble putting the two together.

Again, here is the code I am having problems with:

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")

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

' The rest of the code repeats the process with other worksheets/named
files

end sub

[Ken Slovak]

Where you are loading a CSV file in that code you'd get the item from
Outlook, I think. I'm not sure, I still don't know exactly how your data is
stored in Outlook as DocumentItems, or even why you'd store it there that
way. I don't think I can help you further with this.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by Andy
The code I last posted is actually different from my original code and
I am finding it hard to finish it. I've tried using your code to fix
it but it isn't as simple as the previous issue.
The original was only to move files from Outlook to a folder in a
shared drive. That's fine and sorted but I'm now trying to fix a
similar issue but with more steps in the process, and that is where my
problem is.
The code is in Excel itself but I need to modify it to work with
Outlook.
Currently it imports data from CSV files and pastes it into Excel
which works fine - all I need to do is change it to pull the data from
Outlook instead of the shared drive.
I guess the simple explanation for what I'm asking is that I already
have almost working code, and you have explained very well how to
modify the code but I am having trouble putting the two together.
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")
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
' The rest of the code repeats the process with other worksheets/named
files
end sub

[Andy]

You've been more than helpful already - Thanks Ken