PDA

View Full Version : Solved: Copy files from folder to folder according to list



Meatball
01-04-2010, 10:07 AM
I have a folder with .dwg files. I have a spreadsheet with a list of items, some of which but not all are in the folder. The spreadsheet does not include the file extension.
I would like to make a macro that will go through the spreadsheet, find the matching files in the folder and copy them to another folder.
The spreadsheet with the list will always be the same name ( a template), the searched folder will always be the same, Y:\Gould Southern Info\GA Kits\AutoCad Library, and the destination folder will always be the same, lets say Y:\Gould Southern Info\GA Kits\Temp Cad Folder.
Any help would be appreciatted.

GTO
01-04-2010, 02:19 PM
Try:

Option Explicit

Sub exa()
Dim FSO As Object
Dim rCell As Range
Dim rngFileNames As Range

'// Change paths and extension to suit. //
Const FOL_FROM As String = "D:\110609M\123109\Ch2_Lv1\"
Const FOL_TO As String = "D:\110609M\123109\Ch1_Lv1\"
Const EXT As String = ".txt"

'// Change range to suit //
Set rngFileNames = Selection

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each rCell In rngFileNames
'// Ensure that source file exists and that its not //
'// already copied. //
If FSO.FileExists(FOL_FROM & rCell.Value & EXT) _
And Not FSO.FileExists(FOL_TO & rCell.Value & EXT) Then
FSO.CopyFile FOL_FROM & rCell.Value & EXT, FOL_TO, False
End If
Next
End Sub

Hope that helps,

Mark

Meatball
01-04-2010, 02:50 PM
Thanks for the help GTO.
I changed the code to as follows
[vba]Sub PullFromLibrary()
Dim FSO As Object
Dim rCell As Range
Dim rngFileNames As Range

'// Change paths and extension to suit. //
Const FOL_FROM As String = "Y:\Gould Southern Info\GA Kits\AutoCad Library"
Const FOL_TO As String = "Y:\Gould Southern Info\GA Kits\P.O. Assigned (Ordered) Kits\CADHolder"
Const EXT As String = ".dwg"

'// Change range to suit //
Set rngFileNames = ("A1:A50")

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each rCell In rngFileNames
'// Ensure that source file exists and that its not //
'// already copied. //
If FSO.FileExists(FOL_FROM & rCell.Value & EXT) _
And Not FSO.FileExists(FOL_TO & rCell.Value & EXT) Then
FSO.CopyFile FOL_FROM & rCell.Value & EXT, FOL_TO, False
End If
Next
End Sub
[\vba] and get a "Type Mismatch" error at
Set rngFileNames = ("A1:A50").
Also what happens if there is not a corrosponding file in the folder being copied from? As I said not all of the items in the list will have a matching file in the folder.
Also what does GTO stand for? I used to own a 67 Goat and was wondering if it had anything to do with the car.

Meatball
01-04-2010, 02:53 PM
Goofed on the code tags
Sub PullFromLibrary()
Dim FSO As Object
Dim rCell As Range
Dim rngFileNames As Range

'// Change paths and extension to suit. //
Const FOL_FROM As String = "Y:\Gould Southern Info\GA Kits\AutoCad Library"
Const FOL_TO As String = "Y:\Gould Southern Info\GA Kits\P.O. Assigned (Ordered) Kits\CADHolder"
Const EXT As String = ".dwg"

'// Change range to suit //
Set rngFileNames = ("A1:A50")

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each rCell In rngFileNames
'// Ensure that source file exists and that its not //
'// already copied. //
If FSO.FileExists(FOL_FROM & rCell.Value & EXT) _
And Not FSO.FileExists(FOL_TO & rCell.Value & EXT) Then
FSO.CopyFile FOL_FROM & rCell.Value & EXT, FOL_TO, False
End If
Next
End Sub

lucas
01-04-2010, 02:54 PM
You can always edit your own post and add the tags you know.

Meatball
01-04-2010, 03:26 PM
Thanks Lucas, I will try to remember.

I changed the line in question to
Set rngFileNames = ThisWorkbook.Worksheets("Sheet1").Range("A1:A50")
I do not get the error message but I also do not get any results.

GTO
01-04-2010, 09:27 PM
Hi there,

You left out the trailing path seperators:

'// Change paths and extension to suit. //
Const FOL_FROM As String = "Y:\Gould Southern Info\GA Kits\AutoCad Library\"
Const FOL_TO As String = "Y:\Gould Southern Info\GA Kits\P.O. Assigned (Ordered) Kits\CADHolder\"

Mark

Meatball
01-05-2010, 06:40 AM
One little thing can make such a difference. Thank you GTO for your help.

GTO
01-05-2010, 07:33 AM
:friends: You are most welcome :)