Consulting

Results 1 to 14 of 14

Thread: VBA Code to move files to another folder

  1. #1
    VBAX Newbie
    Joined
    Aug 2013
    Posts
    5
    Location

    VBA Code to move files to another folder

    Hi I am very new to VBA programming (3 days worth of knowledge), so please bear with me. I know there probably is code that can help me with my problem, but I am having trouble finding a code online that will help me.

    I am looking for a way that will assist me in moving, not copying, specific files in one folder to another folder.
    I am working with about 35,000 files in a folder, and about 2,000 of them are irrelevant and need to be moved to conserve space on the server to another folder on my computer's harddrive to save if needed for the future.

    What I have now is a list of the file names with extensions that need to be moved in the first column of an excel sheet.

    I appreciate any help you guys can give me, Thanks!

  2. #2
    VBAX Mentor
    Joined
    Jul 2012
    Posts
    398
    Location
    Sub movefile2()
    oldpath = "E:\test1\"
    newpath = "E:\test2\"
    Fname = Dir(oldpath & "*.xls*")
    Do While Fname <> ""
        Name oldpath & Fname As newpath & Fname
        Fname = Dir
    Loop
    End Sub

  3. #3
    VBAX Newbie
    Joined
    Aug 2013
    Posts
    5
    Location
    Thanks patel for the quick reply, however it's not doing anything when I run it... I have entered the correct folder locations for the oldpath and newpath, but is there something else I am missing?
    If it makes a difference, I am working with 10 different types of file extensions (.asm .dwf .dxf .stp .sat .prt .igs .ipt .jpg and .pdf) and there is no pattern to which file extensions are going to be moved.
    Last edited by graffosu; 08-06-2013 at 09:51 AM. Reason: clarification

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    shell "cmd /c move c:\temp\*.* c:\temp\temp2",vbNormalFocus

  5. #5
    VBAX Newbie
    Joined
    Aug 2013
    Posts
    5
    Location
    Quote Originally Posted by Kenneth Hobs View Post
    shell "cmd /c move c:\temp\*.* c:\temp\temp2",vbNormalFocus
    Hi Kenneth, while it did move files, it moved all the files. I'm only looking to move specific files that I name in the excel sheet and leave the ones I don't have in the sheet.

  6. #6
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    You just need to add your qualifiers. I would use an array to test the extension...

    Sub MoveFiles()
        Dim OldPath As String
        Dim NewPath As String
        Dim LoopFile As String
        Dim FileExt() As String
        OldPath = "C:\Users\Zack\Desktop\TEST\"
        NewPath = "C:\Users\Zack\Desktop\DEST\"
        LoopFile = Dir(OldPath & "*.*")
        Do While LoopFile <> ""
            FileExt = Split(LoopFile, ".")
            Select Case FileExt(UBound(FileExt))
            Case "asm", "dwf", "dxf", "stp", "sat", "prt", "igs", "ipt", "jpg", "pdf"
                Name OldPath & LoopFile As NewPath & LoopFile
            End Select
            LoopFile = Dir
        Loop
    End Sub
    Edit: BTW, change the file folders to your specifics. Above used for testing.

  7. #7
    VBAX Newbie
    Joined
    Aug 2013
    Posts
    5
    Location
    Quote Originally Posted by Zack Barresse View Post
    You just need to add your qualifiers. I would use an array to test the extension...

    Sub MoveFiles()
        Dim OldPath As String
        Dim NewPath As String
        Dim LoopFile As String
        Dim FileExt() As String
        OldPath = "C:\Users\Zack\Desktop\TEST\"
        NewPath = "C:\Users\Zack\Desktop\DEST\"
        LoopFile = Dir(OldPath & "*.*")
        Do While LoopFile <> ""
            FileExt = Split(LoopFile, ".")
            Select Case FileExt(UBound(FileExt))
            Case "asm", "dwf", "dxf", "stp", "sat", "prt", "igs", "ipt", "jpg", "pdf"
                Name OldPath & LoopFile As NewPath & LoopFile
            End Select
            LoopFile = Dir
        Loop
    End Sub
    Edit: BTW, change the file folders to your specifics. Above used for testing.
    Thanks Zack, though I must be doing something wrong.. I am using this code:

     Sub movefile2()
        Dim OldPath As String
        Dim NewPath As String
        Dim LoopFile As String
        Dim FileExt() As String
        OldPath = "C:\Users\KG03665\Desktop\from\"
        NewPath = "C:\Users\KG03665\Desktop\to\"
        LoopFile = Dir(OldPath & "*.*")
        Do While LoopFile <> ""
            FileExt = Split(LoopFile, ".")
            Select Case FileExt(UBound(FileExt))
            Case "txt", "docx", "xlsx", "xls", "bmp"
                Name OldPath & LoopFile As NewPath & LoopFile
            End Select
            LoopFile = Dir
        Loop
    End Sub
    I'm using a dummy folder and files to see if they move correctly before I do it in the server folder. The macro is being ran in a excel sheet that has one column that has only 3 files and their extensions that I want to be transferred, though I have 7 files in the oldpath folder. When I run the code, it's transferring all 7 files to the newpath folder. Am I forgetting to change something in the code you gave me? Sorry for being so dense!

  8. #8
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    There are several things to check when you move files. Does the target folder exist? Does the same file name exist in both the source and target folders, etc. This code sort of does that.

    I could have just used the Name command instead with similar concepts using just VBA built-incommands.

    The Shell method is actually better but you may not like flashing of the shell window so I did not show it. It is easily done though.

    Sub MoveFiles()
      Dim r As Range, c As Range
      Set r = Range("A2", Range("A2").End(xlDown))
      For Each c In r
        MoveCurrent c.Value2, "c:\temp", "c:\temp\temp2"
      Next c
    End Sub
    
    Public Sub MoveCurrent(file$, pathFrom$, pathTo$)
        Dim fso As Object
        Dim sourceFile As String
        Dim targetFile As String
        Dim answer As Integer
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        If Right(pathFrom$, 1) <> "\" Then sourceFile = pathFrom$ & "\" & file$
        If Right(pathTo$, 1) <> "\" Then targetFile = pathTo$ & "\" & file$
        
        With fso
          If Not .folderexists(pathTo$) Then
              MkDir pathTo$
          End If
          
          If .fileexists(targetFile) Then
              answer = MsgBox("File already exists in this location. " _
                  & "Are you sure you want to continue? If you continue " _
                  & "the file at destination will be deleted!", _
                  vbInformation + vbYesNo)
              If answer = vbNo Then
                  Exit Sub
              End If
              Kill targetFile
          End If
          If .fileexists(sourceFile) Then .MoveFile sourceFile, targetFile
        End With
        Set fso = Nothing
    End Sub

  9. #9
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Just to show another method, here is an API method. It is not that complicated. The part to modify is the last Sub.

    ' http://stackoverflow.com/questions/14504372/moving-files-from-one-folder-to-another-in-vba
    Private Declare Function SHFileOperation Lib "shell32.dll" _
    Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
    
    ' // Shell File Operations
    
    Private Const FO_MOVE = &H1
    Private Const FO_COPY = &H2
    Private Const FO_DELETE = &H3
    Private Const FO_RENAME = &H4
    Private Const FOF_MULTIDESTFILES = &H1
    Private Const FOF_CONFIRMMOUSE = &H2
    Private Const FOF_SILENT = &H4                      '  don't create progress/report
    Private Const FOF_RENAMEONCOLLISION = &H8
    Private Const FOF_NOCONFIRMATION = &H10             '  Don't prompt the user.
    Private Const FOF_WANTMAPPINGHANDLE = &H20          '  Fill in SHFILEOPSTRUCT.hNameMappings
                                          '  Must be freed using SHFreeNameMappings
    Private Const FOF_ALLOWUNDO = &H40
    Private Const FOF_FILESONLY = &H80                  '  on *.*, do only files
    Private Const FOF_SIMPLEPROGRESS = &H100            '  means don't show names of files
    Private Const FOF_NOCONFIRMMKDIR = &H200            '  don't confirm making any needed dirs
    
    Private Type SHFILEOPSTRUCT
        hWnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Long
        hNameMappings As Long
        lpszProgressTitle As Long
    End Type
    
    Sub Sample()
        Dim fileToOpen As Variant
        Dim outputfolder As String
        Dim i As Long
    
        outputfolder = "C:\Temp\"
    
        fileToOpen = Application.GetOpenFilename(MultiSelect:=True)
    
        If IsArray(fileToOpen) Then
            If Dir(outputfolder) = "" Then MkDir outputfolder
    
            For i = LBound(fileToOpen) To UBound(fileToOpen)
                Call VBCopyFolder(fileToOpen(i), outputfolder)
            Next i
        Else
              MsgBox "No files were selected."
        End If
    End Sub
    
    Private Sub VBCopyFolder(ByRef strSource, ByRef strTarget As String)
        Dim op As SHFILEOPSTRUCT
        With op
            .wFunc = FO_MOVE
            .pTo = strTarget
            .pFrom = strSource
            .fFlags = FOF_SIMPLEPROGRESS
        End With
        '~~> Perform operation
        SHFileOperation op
    End Sub
    
    
    Sub VBMoveFiles()
      Dim r As Range, c As Range, s As String
      Set r = Range("A2", Range("A2").End(xlDown))
      On Error Resume Next
      For Each c In r
        s = "c:\temp\" & c.Value2
        If Dir(s) <> "" Then VBCopyFolder s, "c:\temp\temp2"
      Next c
    End Sub

  10. #10
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    I'm not sure why it doesn't work for you. Worked for me. I'd take a look at the file extensions you have listed in the code and what you have in the your folder.

    As far as the Shell method goes, it does work, but will be more expensive in terms of efficiency than the Name method, which works pretty fast, and doesn't need to create a separate object to work (same with FSO). The API method should be pretty quick as well. Becareful with that as it uses a private file type, which isn't bad of in itself, but too many types can lead to problems down the road (don't remember where the documentation is on this).

    If you can't get the Name method to work I wouldn't even waste time on it. I'd just use one of the solutions Kenneth posted and call it good.

  11. #11
    VBAX Newbie
    Joined
    Aug 2013
    Posts
    5
    Location
    Thanks Kenneth! It worked perfectly! Thank you all for your help

  12. #12
    VBAX Newbie
    Joined
    May 2014
    Posts
    2
    Location
    Hi everybody,

    In my case, after run sub " Items_output "
    Please help me coding: " how to create folder and move file with conditions at sheet code ?? "
    Ex: file " 1.Acc.6277- Dep_A - items_1.xls " will stored in " Cost\Dep_A " folder
    file " 6.Acc.622 - Dep_B - items_2.xls " will stored in " Cost\Dep_B " folder
    file " 17.Acc.6277 - Dep_C - items_1.xls " will stored in " Cost\Dep_C " folder
    file " 18.Acc.6418 - Dep_D - items_3.xls " will stored in " management " folder

    Hope and note with many thanks !
    Details, please see attachments.
    Attached Files Attached Files

  13. #13
    VBAX Newbie
    Joined
    May 2014
    Posts
    2
    Location
    Quote Originally Posted by quick87 View Post
    Hi everybody,

    In my case, after run sub " Items_output "
    Please help me coding: " how to create folder and move file with conditions at sheet code ?? "
    Ex: file " 1.Acc.6277- Dep_A - items_1.xls " will stored in " Cost\Dep_A " folder
    file " 6.Acc.622 - Dep_B - items_2.xls " will stored in " Cost\Dep_B " folder
    file " 17.Acc.6277 - Dep_C - items_1.xls " will stored in " Cost\Dep_C " folder
    file " 18.Acc.6418 - Dep_D - items_3.xls " will stored in " management " folder

    Hope and note with many thanks !
    Details, please see attachments.
    Look forward to the help of everybody !
    Thank.

  14. #14
    Hi, I am new to VBA and know very basics of coding. However I found a code to copy a list of files from a column in the Macro sheet to a different folder by giving the Source path and the destination path.

    I have created a Macro file with
    List of files with extensions in Column A starting from row 3
    Source path In Cell D1
    Destination Path in Cell D4
    And the files which were not located will show up in the respective rows of column K


    Below is a code that I have been uising for Copying a list of files from one folder to another. I am looking for a code similar for moving files from one folder to another

    Sub BulkfindandcopyMacro()
    ' BulkfindandcopyMacro Macro
    ' Bulk find and copy Macro
    Dim r As Long
        Dim SourcePath As String
        Dim dstPath As String
        Dim myFile As String
    
    
        SourcePath = Range("D1")
        dstPath = Range("D4")
    'Turn Screen Updating Off
    Application.ScreenUpdating = False
        On Error GoTo ErrHandler
                
        For r = 3 To Range("A" & Rows.Count).End(xlUp).Row
            myFile = Range("A" & r)
            FileCopy SourcePath & "" & myFile, dstPath & "" & myFile
    
    
            If Range("A" & r) = "" Then
               Exit For
            End If
    
    
        Next r
    
    
            MsgBox "FILES COPIED"
    Exit Sub
    
    
    ErrHandler:
        Application.DisplayAlerts = False
        Application.DisplayAlerts = True
    
    
    Range("A" & r).Copy Range("K" & r)
    
    
    Resume Next
    
    
    End Sub

    Thanks in Advance!
    Last edited by Paul_Hossler; 02-26-2020 at 07:26 AM.

Posting Permissions

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