Transfer files to the folder

[Abhijeet]

Hi

I have different extension files in folder i have move all files as per extension in that extension name folder. For example File name is 01Payroll .xls , 02 Payment.doc , 03 recept.pdf , 04 List of Debtor.jpg

these types of files i want to move in same folder sub folder are these Excel,Word,Pdf,Jpg
please tell me how to do this with help of macro

 

[Deepak]

@Abhijeet

Pls Share the complete list of file extension & their corresponding folder.

 

[Abhijeet]

Hi deepak
file extension types 1).xls 2).doc 3).pdf 4).jpg 5).gif

In same folder sub folder i want create for these if folder not created then create folder 1st then move the files( i want cut paste the files)
.xls files move in to Excel folder
.doc files move in to Word folder
.pdf file move in to PDF folder
.jpg & .gif files move in to Image folder

 

[Deepak]

Check this..

Sub test()
Dim myfolder As String, obj As Object, m As Variant, strfol As String
Dim ex As Variant, fol As Variant

myfolder = Application.ThisWorkbook.Path

ex = Array("xls", "doc", "Pdf", "jpg", "gif")
fol = Array("Excel", "Word", "Pdf", "Image", "image")

With CreateObject("Scripting.FileSystemObject")
    For Each obj In .GetFolder(myfolder).Files
        m = Application.Match(Right(obj, 3), ex, 0)
        If IsNumeric(m) Then
            strfol = myfolder & "\" & fol(m - 1)
            If Len(Dir(strfol)) = 0 Then MkDir strfol
            Name obj As strfol & "\" & obj.Name
        End If
    Next
End With

End Sub