Move files to another folder by VBA

[jmazorra]

Hello folks:

I am looking to add to the code below.

Private Sub Exitbtn_Click()
Dim MyPath$, MyName$
 
'Save the file to this path and type file name
 
MyPath = ThisWorkbook.Path & "\"
 
MyName = "Salary.Survey.Dashboards" & ".xlsm"
 
ActiveWorkbook.SaveAs MyPath & MyName
Kill MyPath & "\2011.1004.Salary Survey Template.xlsm"
 
MsgBox "File is Saved Under " & MyPath
 
Unload Me
 
End Sub

I needed to move all files with extension .xls and .csv to MyPath &"\Uploads". I figure out how to delete files, but I can't seem to get it to move the files.

 

[rexcel]

This should get you started. You need to include "Windows Script Host Object Model" in your references.


Sub move_files()
Dim objFile As File
Dim objFolder As Folder
Dim objFSO As FileSystemObject
Dim current_path As String
Dim dest_path As String
current_path = "C:\test"
dest_path = "C:\test\Uploads"
Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder(current_path)

For Each objFile In objFolder.Files
If (objFile.Name <> ThisWorkbook.Name) And (InStr(1, objFile.Name, ".xls") Or InStr(1, objFile.Name, ".csv")) Then
objFile.Move (dest_path & "\" & objFile.Name)
End If

Next objFile

End Sub


-Rex

 

[Scott Huish]

With native VBA functions:

Sub MoveFiles()
Dim d As String, ext, x
Dim srcPath As String, destPath As String, srcFile As String
srcPath = "C:\test\"
destPath = "C:\test2\"
ext = Array("*.csv", "*.xls")
For Each x In ext
    d = Dir(srcPath & x)
        Do While d <> ""
            srcFile = srcPath & d
            FileCopy srcFile, destPath & d
            Kill srcFile
            d = Dir
        Loop
Next
End Sub

 

[jmazorra]

Thank you both, both options worked.

 

[BMollohan]

Greetings,

I tried this code but nothing moves.

Option Compare Database
Sub Command0_Click()
Dim d As String, ext, x
Dim srcPath As String, destPath As String, srcFile As String
srcPath = "D:\users\nb100\Documents\999-Test"
destPath = "C:\test2\"
ext = Array("*.csv", "*.xls", "*.txt")
For Each x In ext
d = Dir(srcPath & x)
Do While d <> ""
srcFile = srcPath & d
FileCopy srcFile, destPath & d
Kill srcFile
d = Dir
Loop
Next

End Sub



However, nothing happens.

 

[Scott Huish]

At a glance, you are missing the ending backslash here:

srcPath = "D:\users\nb100\Documents\999-Test"

should be:
srcPath = "D:\users\nb100\Documents\999-Test\"

 

[BMollohan]

Hey Scott,

Made it pass the "brain lock" on the slash however, it still does not transfer the file. Please note that I am only targeting "Text" files only sir.

Option Compare Database
Sub Command0_Click()
Dim d As String, ext, x
Dim srcPath As String, destPath As String, srcFile As String
srcPath = "D:\users\nb100\Documents\999-Test\" '---------------------bmo--------- \ Added
destPath = "D:\users\nb100\Documents\999-Test - Archive\" '--------bmo--------- \ Added
ext = Array("*.txt")
For Each x In ext
d = Dir(srcPath & x)
Do While d <> ""
srcFile = srcPath & d
FileCopy srcFile, destPath & d
Kill srcFile
d = Dir
Loop
Next
MsgBox "done"
End Sub

 

[HankJ]

Used it today with success.

Many thanks

HankJ