Text Functions‎ > ‎

Move Files

 
PROBLEM:
"I have a list of filename in a sheet.  These are some of the files in a specific folder on my system.  I would like to move all the files listed on this sheet to a different folder."
 
SPECIFICATIONS:
  1. The source folder is specified in the macro
  2. The list is filenames only, not full paths
  3. The macro should indicate in column B the results... was the file moved or not when the macro ran
  4. Alternate version where pathnames and filetype are variable
 

CODE

Option Explicit

Sub MoveFiles()
'Jerry Beaucaire - 9/1/2012
'Move files listed in column A on a sheet from one folder to another

Dim myPath As String, myDest As String
Dim MyFiles As Range, aFile As Range

myPath = "C:\Path\To\My\Files\"         'remember the \ at the end
myDest = "C:\Path\To\Put\My\Files\"     'remember the \ at the end

Set MyFiles = Sheets("Sheet1").Range("A:A").SpecialCells(xlConstants)

For Each aFile In MyFiles               'evaluate one filename at a time
    If Len(Dir(myPath & aFile.Value)) > 0 Then      'make sure file exists
        Name myPath & aFile.Value As myDest & aFile.Value
        aFile.Offset(, 1).Value = "Moved"
    Else
        aFile.Offset(, 1).Value = "Not Found"
    End If
Next aFile

End Sub

 

CODE

Option Explicit

Sub MoveFilesVariably()
'Jerry Beaucaire - 9/3/2012
'Move files listed in column A on a sheet from one folder to another
'Column A values are partial filenames, the EXT is variable as are the folders

Dim myPath As String, myDest As String, MyExt As String, fNAME As String
Dim MyFiles As Range, aFile As Range

'Source Folder selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = "C:\2012\"       'default path
        .Show
        If .SelectedItems.Count > 0 Then
            myPath = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With

'Destination Folder selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = myPath
        .Show
        If .SelectedItems.Count > 0 Then
            myDest = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With

'The extension (filetype) to move, .pdf or xls, etc.
    MyExt = Application.InputBox("What file type to move? Enter the extension", "Type of file", "PDF", Type:=2)
    If MyExt = "False" Then Exit Sub
   
Set MyFiles = Sheets("Sheet1").Range("A:A").SpecialCells(xlConstants)

For Each aFile In MyFiles               'evaluate one filename at a time
    fNAME = Dir(myPath & "*" & aFile.Value & "*." & MyExt)
    If Len(fNAME) > 0 Then              'make sure file exists
        Name myPath & fNAME As myDest & fNAME
        aFile.Offset(, 1).Value = "Moved"
        fNAME = ""
    Else
        aFile.Offset(, 1).Value = "Not Found"
    End If
Next aFile

End Sub

 


Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!
 
 
 
Comments