moving multiple files to multiple folders with macro

[aminexcel]

Hi Dear Members !

please see this table:

<table style="border-collapse: collapse; width: 151pt;" border="0" cellpadding="0" cellspacing="0" width="201"><tbody><tr style="height: 14.25pt;" height="19"><td class="xl65" style="height: 14.25pt; width: 85pt;" align="center" height="19" width="113">A</td> <td class="xl66" style="width: 66pt;" align="center" width="88">B</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">019927522X.zip</td> <td class="xl66" align="center">019927522X</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">0226454584.zip</td> <td class="xl66" align="center">0226454584</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">0226733327.zip</td> <td class="xl66" align="center">0226733327</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">0230609511.zip</td> <td class="xl66" align="center">0230609511</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">026202408X.zip</td> <td class="xl66" align="center">026202408X</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">0262061538.zip</td> <td class="xl66" align="center">0262061538</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">0262201011.zip</td> <td class="xl66" align="center">0262201011</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">0262610450.zip</td> <td class="xl66" align="center">0262610450</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl65" style="height: 14.25pt;" align="center" height="19">0313336881.pdf</td> <td class="xl66" align="center">0313336881</td> </tr> </tbody></table>
column A include books names of my soft library and column B include folders that this books must move to them. assume that all books are in drive C, "C:\"

now, can i have a macro that:
1- make folders with isbn10 numbers of book (column B numbers)
2- move all books to their folders (for example move 0313336881.pdf to 0313336881 and move 0262061538.zip to 0262061538)

this macro will save many hours !

thanks a lot
sincerely yours
amin

 

[RolfJ]

Assuming that you want to create all ISDN folders in the root directory ("C:\") AND that you have permission to do that (I did NOT include any error handling), the following code should do the job (if I correctly understood your requirements):

Const ROOT_FOLDER As String = "C:\"
 
Sub MoveFiles()
    Dim r As Range
    Set r = ActiveSheet.UsedRange.Columns(1)
    Dim cell As Range
 
    Dim fs, objFile As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
 
    For Each cell In r.Cells
        If Not fs.FolderExists(ROOT_FOLDER & cell.Offset(0, 1).Value) Then
            fs.CreateFolder (ROOT_FOLDER & cell.Offset(0, 1).Value)
        End If
        fs.MoveFile ROOT_FOLDER & cell.Value, ROOT_FOLDER & cell.Offset(0, 1).Value & "\" & cell.Value
    Next cell
End Sub

To find out more about the FileSystemObject methods I am using check out http://msdn.microsoft.com/en-us/library/6tkce7xa(VS.85).aspx.

Hope this helped,
Rolf Jaeger
SoarentComputing
http://soarentcomputing.com

Phone: 800.580.0068
Cell: 510.300.7462

 

[wigi]

Hi

Alternatively:

Sub MoveFiles()
    Const Root As String = "C:\"
    On Error Resume Next
    For Each r In Columns(1).SpecialCells(2)
        MkDir Root & r.Offset(, 1)
        Name Root & r As Root & r.Offset(, 1) & "\" & r
    Next
End Sub

Wigi