Macro? Move files from pathname spreadsheet to new folder?

[sassfam]

It may be an impossible dream - but here's what I'm trying to do:

I have a .csv file with all the paths/filenames of a bunch of drives (for example, cell A2 is "N:EMEA_BusinessPlanEMEA_BusPlan_053002.doc").

I want to move all these files to a new folder (like "Review" or something). I have probably 300 files on the spreadsheet - I know the pathnames are accurate. Idea is, the files get moved, I archive on CD, then they get tossed. There is no rhyme or reason to where these files might be, so sorting folder by subfolder would be gawd-awful time-consuming.

Instead of going thru 4-5 different drives to find the files, select and drag those suckers, it seems like I should be able to write a macro that would use the path from the .csv spreadsheet, find it on the appropriate drive, move it to the new folder, then go on to the next item on the spreadsheet and find it.

Am I dreaming? Help! Thanks!

[Mark O'Brien]

Sure it's possible, give me a few minutes and I'll knock up an example.

Are the files names all in the same column? i.e. A1:A300 or whatever?

[Mark O'Brien]

Here's my example. I've assumed that the filenames are in column A on sheet1, you can change this to whatever you want. I've also just assumed that the new folder is C:Temp. Again, you can change this to whatever you want:

Option Explicit



Public Sub main()



  Dim oFileSystem As Object

  Dim sFolder As String

  Dim sOldFileName As String

  Dim sNewFileName As String

  Dim sFilePath As String

  Dim oRange As Range

  Dim oFileRange As Range

  

  Set oFileSystem = CreateObject("Scripting.FileSystemObject")

'This is my target folder in this example.

'You'll want to change this

  sFolder = "C:Temp"



'Whatever your range is I've assumed that the data is on sheet1 cell A1 to the last cell in A

  With Sheets("Sheet1")

    Set oFileRange = Range(.Range("A1"), .Range("A35536").End(xlUp))

  End With

  

  For Each oRange In oFileRange

    sOldFileName = oRange.Value

    sNewFileName = sFolder & GetFileName(oRange.Value)

    oFileSystem.CopyFile sOldFileName, sNewFileName  'copy file into new location

  Next



End Sub



Private Function GetFileName(ByVal sFullPath As String) As String

  Dim i As Integer

  

  For i = Len(sFullPath) To 1 Step -1

    If Mid(sFullPath, i, 1) = "" Then

      GetFileName = Mid(sFullPath, i, Len(sFullPath) - i + 1)

    End If

  Next



End Function

[btadams]

Mark's macro above will require a reference to the Microsoft Scripting Runtime library. If you don't have this you can try this example below (change the NewPath1 variable to the path you want to move the files to):

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

[Mark O'Brien]

On 2003-02-18 18:09, btadams wrote:
Mark's macro above will require a reference to the Microsoft Scripting Runtime library.

It doesn't require a reference to the Scripting Library, but it does create one. Big difference.

Unless you do some hardcore customising when you install Office, you'll have the Scripting library.

[NateO]

Hello,

Mark's macro above will require a reference to the Microsoft Scripting Runtime library.

Yes, agreeing with Mark and tacking on, it's a matter of Early vs. Late Binding. While late binding, as demonstrated above is less efficient in a compiled project, it requires no specific library references, one less thing to throw at the OP.

You are on your own for objects, methods, and properties thought.

_________________
Cheers, Nate Oliver

[ This Message was edited by: NateO on 2003-02-21 13:29 ]

[ActM11]

I know this is an old post but the code discussed here does what I need to do but when I tried it, I got the error "run-time error 53, file not found" highlighting the line "Name DocName As NewFilePath".

I'm using Excel 2010 and what I need is to move images files from one folder to another using the reference from excel.

My excel file has column C with the image names of each product, and I have the folder H:\images where there is a lot of images, including those images referenced in the excel column C. I need a macro to move from H:\images to H:\newfolder only the images that are mentioned on the column C.

Someone can help me please? - I'm behind the deadline on this project.

Thanks in advance!!!

[Aliqux]

I know this post is old but I hope this will help anyone that is looking for help

ActM11 - Though you probably don't need this anymore this is the macro that I used to copy files. I tweaked it to your specifications.

Sub copyDirectory()

Dim myDir As String
Dim myDest As String
Dim myCell As String
Dim myCount As Single
'mycount is the starting row that the file names start at
myCount = 1

Do
'Change this to the Column you want to read
myCell = Range("C" & myCount)
'Change this to the location that the files are in
myDir = "H:\images"
'Change this to the location the files are to be copied to
myDest = "H:\newfolder"

FileCopy myDir & myCell, myDest & myCell
myCount = myCount + 1
'Will loop until the first empty cell
Loop Until IsEmpty(Range("C" & myCount))

End Sub

[rj_rohit]

Hi,
I need a li'l bit help as i m new to VBA.
I just wanted to move no of folders to another folder.
I'm not getting how to write VB coding for this.

as i have 20 folders(having name 1...20). In those i want to move half in New Folder"A" and remaining in Folder"B" as such manner written in excel sheet.
Pls Help

//Rj