Copying files to common location

Very_Confused

New Member
Joined
Aug 26, 2011
Messages
6
Hello,
I am trying to copy files from different directories into a new, common directory. I have the full pathways for each file of interest listed in column A of an excel spreadsheet. From a previous thread, below macro seems like it should work but for some reason I cannot figure it out. i think the problem may be with the FileOrFolderName Function? Any suggestions would be very helpful thanks much!!!


Sub SaveFilesToFolder()
Dim NewPath As String
Dim OldFilePath As String
Dim NewFilePath As String
Dim DocName As String
Dim OldDir As String

Dim i As Integer
NewPath1 = "C:TempMyFolder" 'Change path
Range("A4").Select
i = 0
Do While ActiveCell.Value <> ""
OldDir = FileOrFolderName(OldFilePath, False) & ""
On Error Resume Next
ChDir OldDir
On Error GoTo 0
OldFilePath = ActiveCell.Value
DocName = FileOrFolderName(OldFilePath, True)
NewFilePath = "C:TempMyFolder" & DocName ' new file location
' FileCopy DocName, NewFilePath 'copy the file to new folder
' Kill OldFilePath 'delete the old file
Name DocName As NewFilePath ' move the file
ActiveCell.Offset(1, 0).Select
Loop

End Sub
Function FileOrFolderName(InputString As String, ReturnFileName As Boolean) As String
' returns the foldername without the last pathseparator or the filename
Dim i As Integer, FolderName As String, FileName As String
i = 0
While InStr(i + 1, InputString, Application.PathSeparator) > 0
i = InStr(i + 1, InputString, Application.PathSeparator)
Wend
If i = 0 Then
FolderName = CurDir
Else
FolderName = Left(InputString, i - 1)
End If
FileName = Right(InputString, Len(InputString) - i)
If ReturnFileName Then
FileOrFolderName = FileName
Else
FileOrFolderName = FolderName
End If
End Function
 
Last edited:

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Can you post an example of your "path" data. It would be helpful if I had a clue as to exact layout.
Do the "paths" include filenames, backslashes, etc.
 
Upvote 0
Thanks for responding! Here are some examples. The the pathways i have in the spreadsheet are not a uniform as these (Im not sure if that matters...) but all the basic elements are there

E:\HabDis\Sp_3\sp3.prj
E:\HabDis\Sp_3\Sp3.dbf
E:\HabDis\Sp_2\SP2.dbf
E:\HabDis\Sp_2\Sp2.prj
E:\HabDis\Sp_1\Sp1.dbf
E:\HabDis\Sp_1\Sp1.prj

The new folder, where i'd like to copy these files would be something like C:\SGCN. Please let me know if you need any other information. Thanks again!!!
 
Last edited:
Upvote 0
Code:
Sub NewFCTest()
Set fc = CreateObject("Scripting.FileSystemObject")
Sheets("Sheet1").Select
    Set Rng1 = Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
    Var1 = "C:\TempMyFolder\"
    For Each c In Rng1
        fc.copyfile c, Var1
    Next c
End Sub
Code assumes Sheet1 exists with a list of folders and filenames in column A.
It also assumes the folder TempMyFolder exists.
 
Upvote 0
Thanks! This is much easier to follow, however i am getting a permission denied error. Could this be due to opening the file before it moves - in a sense locking the file? The files shouldn't be write protected...
 
Upvote 0
Can you post the code you are using?
Your sample code used C:\TempMyFolder\.
Your second post mentioned C:\SGCN.

Are any of the files opened when the code runs? The code I posted does not open any.
Also, my code makes a copy of the files, it does not move them.
 
Upvote 0
Here is what i've been using. Its the same as above except for C:\Users\Owner\Desktop\SGCN. The error code is run-time error 70: permission denied. I have confirmed that the files are not open when i run the program, and copying is exactly what i want to do... Thanks for being so patient

Sub NewFCTest()
Set fc = CreateObject("Scripting.FileSystemObject")
Sheets("Sheet1").Select
Set Rng1 = Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
Var1 = "C:\Users\Owner\Desktop\SGCN"
For Each c In Rng1
fc.copyfile c, Var1
Next c
End Sub
 
Upvote 0
Windows does not allow "DOS" procedures in the "Users" folder and its subfolders.
I tried changing "permissions" to the "Users" folder and my PC said I needed "Admin" rights.
I would suggest copying your files to a non System folder and not messing with Windows "protected" folders.
 
Upvote 0
OK that seems reasonable. is there any other work around to enable this program? Ideally, i would like to keep things as neat as possible. What do you mean by non system folder? Something like an external drive?
 
Upvote 0
What do you mean by non system folder?
What I mean here is any folder that you create outside "C:\Users\". Just create any folder in C: drive and change the code to point to that. That is what I did when testing the code I posted for you and it worked fine.
When I tested a path in "C:\Users\John\Desktop\SGCN" i got the same error you did.
When I created and used a path like your first listing, "C:\TempMyFolder\", it worked fine.
 
Upvote 0

Forum statistics

Threads
1,224,525
Messages
6,179,319
Members
452,905
Latest member
deadwings

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