Tuesday, January 13, 2015

Excel VBA move PDF files to specific folder


Lets say you have your employee files or customer files in a single folder with employee name /customer name in the beginning (say 1st six digit).

Now you want to move all of them to individual employee / customer wise folder?

Tons of thousands of employees /customers & cant do manually.. Here goes macro...

Sub move_PDF()

Dim fldr As FileDialog

Dim emp As String, SourceFldr As String, DestFldr As String

Dim FileToOpen As Variant

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

With fldr

    .Title = "Select a Source Folder"

    .AllowMultiSelect = False

    .InitialFileName = strPath

    If .Show <> -1 Then GoTo NextCode

    SourceFldr = .SelectedItems(1) & "\"


End With

With fldr

    .Title = "Select a Destination Folder"

    .AllowMultiSelect = False

    .InitialFileName = strPath

    If .Show <> -1 Then GoTo NextCode2

    DestFldr = .SelectedItems(1) & "\"


End With

FileToOpen = Dir(SourceFldr & "*.pdf")

Do While FileToOpen <> ""

'check if folder exists

Dim FSO As Object

Set FSO = CreateObject("scripting.filesystemobject")

emp = Left(FileToOpen, 6)

If FSO.FolderExists(DestFldr & emp) = False Then

MkDir DestFldr & emp

End If


'Move file

Name SourceFldr & FileToOpen As DestFldr & emp & "\" & FileToOpen

FileToOpen = Dir


MsgBox "Files moved"

End Sub