Move certain files in a folder to another using excel VBA?

[Legacy 293160]

Hi all excel gurus!

I searched for few hours before disturbing you guys but didnt find anything useful.

I have a folder with a number of files and want to move some of them to another folder

the way I'd like it to be done is that in the excel spreadsheet, I list the path and names of the source files then in the next column lists the path and names of the destination folder.

then I need a macro to go an find these files and move them to new destination.

please see below of what I mean


-- removed inline image ---



any help much appreciated

thanks very much

 

[bertie]

Hi, and welcome to the forum.

Unfortunately, your image file is not visible, so this solution is based on the sample data below.

Excel 2007
	A	B	C
1	Source Path	FileName	Destination Path
2	C:\temp\	Book1.xlsx	C:\temp\archive\
3	C:\temp\	Book2.xlsx	C:\temp\archive\
4	C:\temp\	Book3.xlsx	C:\temp\archive\
Sheet1

To move the files we use:

      'move the file
      Name oldFileName As newFileName

NB The source path (column A in the sample data) and destination path (column C) must exist.

For this example I loop through the data in rows 2-4 inclusive.
The old file name is built by concatenating the value in column A and B - EDIT to match your data.
The new file name, by concatenating column C and B - EDIT to match your data.

      With Sheets("Sheet1")
         oldFileName = .Range("A" & i).Value & .Range("B" & i).Value
         newFileName = .Range("C" & i).Value & .Range("B" & i).Value
      End With

The full test code is below.
To use:
Press Alt+F11 to open the vba editor window.
Double click the ThisWorkbook module in the project Window on the left hand side.
Copy and paste the code. below.

Option Explicit


Sub MoveFiles()
   Dim i As Long
   Dim oldFileName As String
   Dim newFileName As String
   
   For i = 2 To 4 '***EDIT THIS TO SUIT YOUR NEEDS***
      With Sheets("Sheet1")
         oldFileName = .Range("A" & i).Value & .Range("B" & i).Value
         newFileName = .Range("C" & i).Value & .Range("B" & i).Value
      End With
      
      'move the file
      Name oldFileName As newFileName
   Next i
End Sub

Hope this helps,
Bertie

 

[Legacy 293160]

thank you so much!
you are the champion!

however, sorry to bother you again 1 more step is left I guess. I wanna built this macro for people who have 0 knowledge of VBA and just wanna click a button which I will assign this macro to to ork. therefore, is there anyway that we dont need to adjust "i" which is currently 2 to 4 in the code? I put 2 to 4000 just for sake of it since I need it to be flexible to work for any number of rows in column A.

So, could you please kindly modify it so one doesnt have to go ointo VBA to modify "i".

Thanks so much once again

Hi, and welcome to the forum.

Unfortunately, your image file is not visible, so this solution is based on the sample data below.

Excel 2007

	A	B	C
1	Source Path	FileName	Destination Path
2	C:\temp\	Book1.xlsx	C:\temp\archive\
3	C:\temp\	Book2.xlsx	C:\temp\archive\
4	C:\temp\	Book3.xlsx	C:\temp\archive\

<colgroup><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

To move the files we use:

      'move the file
      Name oldFileName As newFileName

NB The source path (column A in the sample data) and destination path (column C) must exist.

For this example I loop through the data in rows 2-4 inclusive.
The old file name is built by concatenating the value in column A and B - EDIT to match your data.
The new file name, by concatenating column C and B - EDIT to match your data.

      With Sheets("Sheet1")
         oldFileName = .Range("A" & i).Value & .Range("B" & i).Value
         newFileName = .Range("C" & i).Value & .Range("B" & i).Value
      End With

The full test code is below.
To use:
Press Alt+F11 to open the vba editor window.
Double click the ThisWorkbook module in the project Window on the left hand side.
Copy and paste the code. below.

Option Explicit


Sub MoveFiles()
   Dim i As Long
   Dim oldFileName As String
   Dim newFileName As String
   
   For i = 2 To 4 '***EDIT THIS TO SUIT YOUR NEEDS***
      With Sheets("Sheet1")
         oldFileName = .Range("A" & i).Value & .Range("B" & i).Value
         newFileName = .Range("C" & i).Value & .Range("B" & i).Value
      End With
      
      'move the file
      Name oldFileName As newFileName
   Next i
End Sub

Hope this helps,
Bertie

 

[bertie]

If you are going to distribute your code then we need to tighten it up a bit.

So, using the sample data from my earlier post:

Old File Section
We need to check the value in column A has an end backslash, if not, add it.
We then call a function to test if the file exists, if not highlight the cell RED and move on to the next row.

New File Section
Again we check for the end backslash and add it if necessary.
We send the path to a procedure, CreateFullPath().
If the path to the NEW file doesn't exist, we prompt the user if they want to create it.
The new file string is split into an array, and we loop through the array building the folder structure.
(There is a Windows API function to do this in one go, but it's name slips my mind at present.)

Move File Section
If the code passes these two test we move the file as before.

The full code is below, test using data for an invalid folder, see new sample data.

Option Explicit


Sub MoveFiles()
   Dim i As Long
   Dim numRows As Long
   Dim oldFileName As String
   Dim newFileName As String
   
   With Sheets("Sheet1")
      'get number of rows to loop through
      numRows = .Range("A" & .Rows.Count).End(xlUp).Row
      
      For i = 2 To numRows
         '====================
         'old file
         '====================
         'build the path, test for end backslash in path for OLD filename
         oldFileName = .Range("A" & i).Value
         If Right(oldFileName, 1) <> "\" Then oldFileName = oldFileName & "\"
         
         'add the file name
         oldFileName = oldFileName & .Range("B" & i).Value
         
         'does the file exist?
         If Not FileFolderExists(oldFileName) Then
            'highlight cell when OLD file doesn't exist, and skip to next row
            .Range("A" & i).Font.Color = vbRed
            GoTo NextLoopIndex
         End If


         '==============
         'new file
         '============
         'test for end backslash in path for NEW filename
         newFileName = .Range("C" & i).Value
         If Right(newFileName, 1) <> "\" Then newFileName = oldFileName & "\"
         CreateFullPath newFileName
         'add on the filename
         newFileName = newFileName & .Range("B" & i).Value
         
         '==================
         'move file
         '===============
         Name oldFileName As newFileName
         
NextLoopIndex:
         oldFileName = ""
         newFileName = ""
      Next i
   End With
End Sub




Private Sub CreateFullPath(ByVal FilePath As String)
   Dim Folders  As Variant
   Dim tmp As String
   Dim i As Long
   
   'does the folder exist?
   If Not FileFolderExists(FilePath) Then
      If MsgBox("File path does not exist. Do you want to create it?", _
                Buttons:=vbYesNo + vbQuestion) = vbYes Then


         'build the folders
         Folders = Split(FilePath, "\")
         For i = LBound(Folders) To UBound(Folders) - 1
            tmp = tmp & Folders(i) & "\"
            If Not FileFolderExists(tmp) Then MkDir tmp
         Next i
      Else
         Exit Sub
      End If
   End If
End Sub




Private Function FileFolderExists(ByVal FilePath As String) As Boolean
   If Not Dir(FilePath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

Excel 2007
	A	B	C
1	Source Path	FileName	Destination Path
2	C:\temps\	Book1.xlsx	C:\temp\archive\
3	C:\temp\	Book2.xlsx	C:\temp\archives\
4	C:\temp\	Book3.xlsx	C:\temp\archive\
Sheet1

 

[Legacy 293160]

thank you so much
greatly appreciated

 

[harky]

Hi, i like this script but can help to enhance more??

Can it create a folder which is not existing?

 

[Mrinalini]

Hi Bertie,

I have followed your script, and utilized it in my code to move files(converted files) from source to destination folder. I have few extensions which cannot be moved from source tod estination, since the error is file not found.

I have traced the issue that the file which is getting converted and placed in source is more than one file. To be simple the source file is pdf, let say it contains 7 pages and it converts into jpeg image and that will be 7 jpeg files ofthe source. When my amcro executes, it looks for the filename of the source the destination file and concatenates with the destination pathto move the file. since the file name contains a suffix as Filename_Page_1 to Filename_Page_7, this error occurs and couldnt process for few extensions like this.

If the file extension is word or excel of my source file(pdf- 7 pages) the output is always 1 page. However the issue occurs only when the file extensions or other than this (jpx, jpf, j2k, jpc).

 

[howard]

Hi Bertie


I came across the code that you posted

It would be appreciated if you could kindly amend this to take into account sub-folders in the source path without having to list the sub-folders

for eg Source file could be c:\accounts\tbbr1\ but only want to list the path C:\accounts\

Excel 2012
	A	B	C
1	Source Dir	File Name	Dest Path
2	C:\accounts\	Br1 TB.xls	c:\old accounts\
Sheet1

 Option Explicit


Sub MoveFiles()
   Dim i As Long
   Dim numRows As Long
   Dim oldFileName As String
   Dim newFileName As String
   
   With Sheets("Sheet1")
      'get number of rows to loop through
      numRows = .Range("A" & .Rows.Count).End(xlUp).Row
      
      For i = 2 To numRows
         '====================
         'old file
         '====================
         'build the path, test for end backslash in path for OLD filename
         oldFileName = .Range("A" & i).Value
         If Right(oldFileName, 1) <> "\" Then oldFileName = oldFileName & "\"
         
         'add the file name
         oldFileName = oldFileName & .Range("B" & i).Value
         
         'does the file exist?
         If Not FileFolderExists(oldFileName) Then
            'highlight cell when OLD file doesn't exist, and skip to next row
            .Range("A" & i).Font.Color = vbRed
            GoTo NextLoopIndex
         End If


         '==============
         'new file
         '============
         'test for end backslash in path for NEW filename
         newFileName = .Range("C" & i).Value
         If Right(newFileName, 1) <> "\" Then newFileName = oldFileName & "\"
         CreateFullPath newFileName
         'add on the filename
         newFileName = newFileName & .Range("B" & i).Value
         
         '==================
         'move file
         '===============
         Name oldFileName As newFileName
         
NextLoopIndex:
         oldFileName = ""
         newFileName = ""
      Next i
   End With
End Sub




Private Sub CreateFullPath(ByVal FilePath As String)
   Dim Folders  As Variant
   Dim tmp As String
   Dim i As Long
   
   'does the folder exist?
   If Not FileFolderExists(FilePath) Then
      If MsgBox("File path does not exist. Do you want to create it?", _
                Buttons:=vbYesNo + vbQuestion) = vbYes Then


         'build the folders
         Folders = Split(FilePath, "\")
         For i = LBound(Folders) To UBound(Folders) - 1
            tmp = tmp & Folders(i) & "\"
            If Not FileFolderExists(tmp) Then MkDir tmp
         Next i
      Else
         Exit Sub
      End If
   End If
End Sub




Private Function FileFolderExists(ByVal FilePath As String) As Boolean
   If Not Dir(FilePath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

[beatkat]

Hi everyone, I'm new here and new to VBA and such. I tried out the code above and it works great however what if I want to make a copy of the files instead of moving them? That way I can make edits to the files without touching the originals.

Thanks!

 

[MountainKris]

Hello. I was wondering how this could be modified so the popup asking if the user wants to create a directory each time one does not already exist? I was going to make a user form with the option Yes to All, but I would rather the code just create directories that do not already exist, rather than asking many times.

Thanks!

Kris