moving/archiving excel files listed in a spreadsheet

[morph81]

Hi

I was hoping someone might be able to assist me/already have a macro which will move files to an archive folder.

Basically I have already have a macro which pulls a list of files from H:\data\Countries... including all files in the subfolders and puts them in a spreadsheet in in column A with the date last modified in column B.

I need to move all files which were last modified before January 2010 to an archive folder which mirrirs the same file path e.g.
H:\data\Countries\ARCHIVE\name of country/name of subfolder/file etc.

I can filter the list of files leaving only the files i need to move, but is there a clean macro which would then move the whole list of files - it will be up around 800+ files so I do not have to do it manually...

I have found this macro online - but can it be tweaked to copy the original folder structure..?


Sub test1() Dim c As Object, x, i As Long, n As Long Set c = CreateObject("Scripting.FileSystemObject") oldpath = "C:\processed\": newpath = "C:\processed\ready\" x = Range([c1], [c1].End(xlDown)) For i = 1 To UBound(x) c.movefile oldpath & x(i, 1), newpath & x(i, 1) n = n + 1 Next: MsgBox n & "files has been successfully moved", vbInformation: End Sub</pre>

Any ideas very welcome!

 

[sijpie]

Lets put your code in a readable format and add non declared variables

Sub ArchiveFiles() 
Dim c As Object, x, i As Long, n As Long 
Dim oldpath as string, newpath as String
 
Set c = CreateObject("Scripting.FileSystemObject") 
oldpath = "C:\processed\"
newpath = "C:\processed\ready\" 
x = Range([c1], [c1].End(xlDown)) 
For i = 1 To UBound(x) 
c.movefile oldpath & x(i, 1), newpath & x(i, 1) n = n + 1 
Next 
MsgBox n & "files has been successfully moved", vbInformation 
End Sub

So the only thing you need to change is the oldpath and newpath variables to suit your need.
Your current macro, how does it store the filenames in the spreadsheet - does it include the paths? Are the paths stored with the file name or as a seperate path?

You will need to set oldpath to the current path within the For loop, and newpath needs to be created from the oldpath by inserting Archive

newpath = Application.WorksheetFunction.Substitute(oldpath, "Countries\", "Countries\Archive\", 1)

 

[morph81]

Thank you Sijpie!

All the files are listed with path e.g.

<TABLE style="WIDTH: 525pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=700><COLGROUP><COL style="WIDTH: 525pt; mso-width-source: userset; mso-width-alt: 25600" width=700><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 525pt; HEIGHT: 15pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=20 width=700>H:\Data\Countries\UK\Industrial production\Old\AFO Backup of Engineering orders.xls

So I would just like to move them to something like:

<TABLE style="WIDTH: 525pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=700><COLGROUP><COL style="WIDTH: 525pt; mso-width-source: userset; mso-width-alt: 25600" width=700><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 525pt; HEIGHT: 15pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=20 width=700>H:\Data\Countries\Archive Pre-January 2010 \UK\Industrial production\Old\AFO Backup of Engineering orders.xls</TD></TR></TBODY></TABLE>
</TD></TR></TBODY></TABLE>
So would the code be:

Code:

Sub ArchiveFiles() Dim c As Object, x, i As Long, n As Long Dim oldpath as string, newpath as String Set c = CreateObject("Scripting.FileSystemObject") oldpath = "H:\Data\Countries\"
newpath = Application.WorksheetFunction.Substitute(oldpath, "Countries\", "Countries\Archive\", 1)
x = Range([c1], [c1].End(xlDown)) For i = 1 To UBound(x) c.movefile oldpath & x(i, 1), newpath & x(i, 1) n = n + 1 Next MsgBox n & "files has been successfully moved", vbInformation


</PRE>
Thanks so much for your help with this!

 

[sijpie]

No, that would not be the code.

Please use the code as i reformatted it. the other code has all the lines jumbeled up and you won't be able to make head or tail from it.

As the path for each file differs, yo will need to process the path within the For.. Next loop

 

[morph81]

OK sorry - I hadn't worked out how to insert a code box..

Have I managed to grasp it now... sorry for being slow on the uptake here, I am real novice...

Sub ArchiveFiles() 
Dim c As Object, x, i As Long, n As Long 
Dim oldpath as string, newpath as String
 
Set c = CreateObject("Scripting.FileSystemObject") 
oldpath = "C:\Data\Countries"
newpath = "C:\Data\Countries\[B]Archive[/B]" 
x = Range([c1], [c1].End(xlDown)) 
For i = 1 To UBound(x) 
c.movefile oldpath & x(i, 1), newpath = Application.WorksheetFunction.Substitute(oldpath, "Countries\", "Countries\Archive\", 1)
 
Next 
MsgBox n & "files has been successfully moved", vbInformation 
End Sub

 

[sijpie]

Let's assume that your list of file names starts from A2

So first we need to set the range being worked through at the correct cells:

x = Range([A2], [A2].End(xlDown))

Next, the file name includes the path. So we need to extract the path from each name.
To do this we look at the last occurance of the '\' character in the file name, as that is where the path finishes.

oldpath = Left(x(i,1),InstrRev(x(i,1), "\"))

Then we do the substitution to get the new path, and now we can move the file from old to new

Sub ArchiveFiles()
Dim c As Object, x, i As Long 
Dim oldPath As String, newPath As String
 
Set c = CreateObject("Scripting.FileSystemObject")
x = Range([a2], [a2].End(xlDown))
For i = 1 To UBound(x)
    oldpath = Left(x(i, 1), InStrRev(x(i, 1), "\"))
    newpath = Application.WorksheetFunction.Substitute(oldpath, "Countries\", "Countries\Archive\", 1)
    c.movefile x(i,1),newpath
 
Next
MsgBox i - 1 & "files have been successfully moved", vbInformation
End Sub

 

[morph81]

That makes SO much sense now, Thanks for simplyfying!

It has worked a treat!