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!

Code:

---

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

---

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.

Code:

---

shell "cmd /c move c:\temp\*.* c:\temp\temp2",vbNormalFocus

---

Quote:

---

Originally Posted by Kenneth Hobs

Code:

---

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.

You just need to add your qualifiers. I would use an array to test the extension...

Code:

---

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.

Quote:

---

Originally Posted by Zack Barresse

You just need to add your qualifiers. I would use an array to test the extension...

Code:

---

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:

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!

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.

Code:

---

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

---

Just to show another method, here is an API method. It is not that complicated. The part to modify is the last Sub.

Code:

---

' 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

---

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. :)

Thanks Kenneth! It worked perfectly! Thank you all for your help :)

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.

Quote:

---

Originally Posted by quick87

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.

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

Code:

---

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!