Consulting

Results 1 to 8 of 8

Thread: Extract files in a folder containing contents in column A and move them to own folder

  1. #1
    VBAX Regular
    Joined
    Feb 2018
    Posts
    70
    Location

    Extract files in a folder containing contents in column A and move them to own folder

    Good afternoon. I'm hoping someone call help me with something I'm working on. I have a file containing lots of documents, excel, pdf and word etc but their names contain a reference number.

    I'd like to be able to enter a reference number in excel, then run a macro which would look for any files in a specific folder containing that reference number and group them together in their own folders and Ideally name the new folder with the reference number I entered in to excel. (there could be 3 or 4 documents in the main folder folder containing that specific reference number so I want to sperate them in to their own folders)

    I hope this makes sense? Is it possible?

    Thank you in advance.

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Hi Lee,

    See below, no error handling but a basic way to get to where you need to. Shorter versions of this code may be supplied by other users now the ball is rolling.

    Sub FindFilesAndMove()    
        Dim MyFolder As String, MyFile As String, srchStr As String, DestFold As String, FSO As Object
       
        Set FSO = CreateObject("Scripting.Filesystemobject")
        srchStr = InputBox("Input search string")
        MyFolder = "C:\Users\JBloggs\Desktop\test\" '<<< change to suit
        DestFold = MyFolder & srchStr & "\"
        MkDir DestFold
        MyFile = Dir(MyFolder)
        
        Do While MyFile <> ""
            If InStr(MyFile, srchStr) Then
                FSO.MoveFile Source:=MyFolder & MyFile, Destination:=DestFold & MyFile
            End If
            MyFile = Dir
        Loop
        
    End Sub
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  3. #3
    VBAX Regular
    Joined
    Feb 2018
    Posts
    70
    Location
    Thank you so much for taking the time to help with this. Its much appreciated. This works perfectly, however rather than enter a single reference in a display box, could I list all the reference in column A and it would go through each one? Sorry if I didn't make that clear. Is there something I can change to do that? Much appreciated.

  4. #4
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Maybe the below assuming the list starts in cell A2:

    Sub FindFilesAndMove()    
        Dim MyFolder As String, MyFile As String, srchStr As String, DestFold As String, FSO As Object, rCell As Range
       
        Set FSO = CreateObject("Scripting.Filesystemobject")
        MyFolder = "C:\Users\jbloggs\Desktop\test\" '<<< change to suit
        
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
            MyFile = Dir(MyFolder)
            srchStr = rCell.Value
            DestFold = MyFolder & srchStr & "\"
            MkDir DestFold
            
            Do While MyFile <> ""
                If InStr(MyFile, srchStr) Then
                    FSO.MoveFile Source:=MyFolder & MyFile, Destination:=DestFold & MyFile
                End If
                MyFile = Dir
            Loop
        Next rCell
    End Sub
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  5. #5
    VBAX Regular
    Joined
    Feb 2018
    Posts
    70
    Location
    Thank you! this works perfectly. You've saved me a massive headache. I would buy you a pint if I could. Instead if you want to nominate a charity I will send a donation to them as a thank you.

  6. #6
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    There is no need, but if you feel you must then it would be CLAPA as I was born with a cleft lip and palate.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  7. #7
    VBAX Regular
    Joined
    Feb 2018
    Posts
    70
    Location
    CLAPA Donation.jpgOne good deed deserves another! I have made a donation to the charity (proof below). Thanks again for your help with this!



  8. #8
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Thanks, that is very kind indeed
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •