PDA

View Full Version : VBA Code to move files to another folder



graffosu
08-06-2013, 08:49 AM
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!

patel
08-06-2013, 09:27 AM
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

graffosu
08-06-2013, 09:48 AM
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.

Kenneth Hobs
08-06-2013, 11:08 AM
shell "cmd /c move c:\temp\*.* c:\temp\temp2",vbNormalFocus

graffosu
08-06-2013, 11:25 AM
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.

Zack Barresse
08-06-2013, 12:35 PM
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.

graffosu
08-06-2013, 01:15 PM
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!

Kenneth Hobs
08-06-2013, 01:54 PM
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

Kenneth Hobs
08-06-2013, 02:15 PM
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

Zack Barresse
08-06-2013, 02:28 PM
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. :)

graffosu
08-07-2013, 05:12 AM
Thanks Kenneth! It worked perfectly! Thank you all for your help :)

quick87
05-13-2014, 01:41 AM
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.

quick87
05-21-2014, 02:51 AM
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.