Excel macro to move all subfolders to another location - excel

I only know to write a macro to copy a file from Folder A to Folder B
FileCopy "C:\Documents\Folder A\test.xlsx", "C:\Documents\Folder B\test.xlsx"
Could someone help for an Excel macro to MOVE all sub-folders and files under "Folder A" to "Folder B". Thank you

Pl Try This: Change folders as per your requirements.
Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
FromPath = "C:\Process_Contract_Notes" '<< Change
ToPath = "C:\Process" '<< Change
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFolder Source:=FromPath, Destination:=ToPath
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub

Related

Upload csv files from a directory to a folder using VBA

I am trying to upload several csv files (with a specific name) from a directory to a folder in my desktop.
I have tried the below mentioned code but nothing comes up.
Sub Copy_Files_Dates()
'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Filename As String
Dim FileInFromFolder As Object
FromPath = "K:\CIU\Data\FRC\monthly_checks*" & "*.csv*" '<< Change
ToPath = "C:\Users\WZHKLXH\Desktop\reporting" '<< Change
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
If Right(ToPath, 1) <> "\" Then
ToPath = ToPath & "\"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If
For Each FileInFromFolder In FSO.getfolder(FromPath).Files
Filename = "monthly_checks*" & ".csv" ' or "dd.mm.yy")
'Copy files from 1-Aug-2020 to 20-Dec-2020
If Fdate >= DateSerial(2020, 7, 1) And Fdate <= DateSerial(2020, 12, 20) Then
FileInFromFolder.Copy ToPath
End If
Next FileInFromFolder
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub

Copy multiple files to multiple folders using FileDialog in Excel vba

I'm trying to build vba code to copy files from a fixed folder to another folder.
My problem is that I want to specify where to copy the files using "Application.FileDialog(msoFileDialogFolderPicker)" and i don't know to do it.
Any help would be appreciated.
Sub Copy_Folder()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim F As Object
Set F = Application.FileDialog(msoFileDialogFolderPicker)
FromPath = "Z:\Templates\Template 2020"
ToPath = "C:\Users\ocosmele\Desktop\New folder"
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFolder source:=FromPath, destination:=ToPath
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub
Just adjusted the first part of your code. Please read the code's comments and adjust it to fit your needs.
Option Explicit
Sub Copy_Folder()
Dim fso As Object
Dim targetFolder As Object
Dim fromPath As String
Dim intialPath As String
Dim toPath As String
' Initialize the file system object
Set fso = CreateObject("Scripting.FileSystemObject")
fromPath = "C:\Temp\Test"
intialPath = "C:\Users\ocosmele\Desktop\New folder"
' Ask user for the destination folder
Set targetFolder = Application.fileDialog(msoFileDialogFolderPicker)
' Define the target folder dialog box properties and result
With targetFolder
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = intialPath
If .Show <> -1 Then
MsgBox "You didn't select anything"
Exit Sub
End If
toPath = .SelectedItems(1)
End With
If Right(fromPath, 1) = "\" Then
fromPath = Left(fromPath, Len(fromPath) - 1)
End If
If Right(toPath, 1) = "\" Then
toPath = Left(toPath, Len(toPath) - 1)
End If
If fso.FolderExists(fromPath) = False Then
MsgBox fromPath & " doesn't exist"
Exit Sub
End If
fso.CopyFolder Source:=fromPath, Destination:=toPath
MsgBox "You can find the files and subfolders from " & fromPath & " in " & toPath
End Sub
Let me know if it works.

use Excel vba to copy a folder to sharepoint

Is it possible to copy a folder to SharePoint using VBA and if so is there sample code on how this is done
Many thanks
James
You can publish an Excel file to Sharepoint (a.k.a. Chèvre-poing), but it looks rather difficult since the authentication mechanism is ill tampered (like goats).
So what you should do is map a local Share with Sharepoint (\\my_chevre_poing\goaty\, then have a little VBA do it from your favorite macro place:
Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
FromPath = "C:\local\trucs\" '<< your own source there
ToPath = "\\my_chevre_poing\goaty_trucs\" '<< your share there
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFolder Source:=FromPath, Destination:=ToPath
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub
You also may find huge resource there.

Copy and Rename Folder using VBA

I have a folder with numerous linked workbooks. I would like to store a master copy of it within the C:\ drive. When someone needs to use it they would click on the below macro to copy the folder, ask what the new name will be and place it on the desktop for use. The below code cycles through but does not place the folder on the desktop. It just seems to disappear and does not copy the original
Hoping someone can help??
Sub Copy_Folder()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim strName As String
FromPath = "C:\v4 Master Operations Folder"
ToPath = "C:\Users\Owner\Desktop"
Application.CutCopyMode = False
Reenter:
strName = InputBox(Prompt:="Enter the name of your operation", _
Title:="Operation.", Default:=" ")
If strName = vbNullString Then
MsgBox "Incorrect Entry."
GoTo Reenter
End If
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath & strName, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFolder Source:=FromPath, Destination:=ToPath & strName
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath & strName
End Sub
It looks like the problem is on this line:
FSO.CopyFolder Source:=FromPath, Destination:=ToPath & strName
You are setting your Destination variable equal to ToPath & strName, so if the user enters "My name" then it would be "C:\Users\Owner\DesktopMy Name". You need to put a slash in there: Destination:=ToPath & "\" & strName

Move folders using file path in excel file using VBA

my goal is to move specified folders and their contents outof an existing location into a new folder path labeled "Archive". There are about 1000 folders out of 2000 I need moved to this new location. I have a .xlsx file that contains the file paths of each folder that needs moving, listed in column A of the Excel worksheet. I would like my macro to look at the Excel file, read the folder path, move that folder and its contents to a new destination. Repeat through the Excel list until it reaches a blank, then it's considered "Done!"
Here is the code I have found so far (see below). This code will move one folder from one path to another path. I need to enhance this to read each path from my Excel file; I just don't know what that part of the command should look like.
Code and any notes with the code are greatly appreciated! Thank you!
Sub Move_Rename_Folder()
'This example move the folder from FromPath to ToPath.
Dim fso As Object
Dim FromPath As String
Dim ToPath As String
FromPath = "Q:\Corporate-Shares\...\Test folder 1" '<< Change
ToPath = "Q:\Corporate-Shares\...\Test Archive Folder" '<< Change
'Note: It is not possible to use a folder that exist in ToPath
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set fso = CreateObject("scripting.filesystemobject")
If fso.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
If fso.FolderExists(ToPath) = True Then
MsgBox ToPath & " exist, not possible to move to a existing folder"
Exit Sub
End If
fso.MoveFolder Source:=FromPath, Destination:=ToPath
MsgBox "The folder is moved from " & FromPath & " to " & ToPath
End Sub
Please test this code in a test folder before working with your original files. Create copies or dummy files, any failure can damage your existing files....
First, separate this move function taking the name and destination of the path:
Sub Move_Rename_Folder(FromPath as string, ToPath as string)
'to do these two lines, go to tools, references and add Microsoft.Scripting.Runtime
'it's a lot easier to work like this
Dim fso As FileSystemObject
Set fso = new FileSystemObject
'you don't need to set paths anymore, they come as the arguments for this sub
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
If fso.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
If fso.FolderExists(ToPath) = True Then
MsgBox ToPath & " exist, not possible to move to a existing folder"
Exit Sub
End If
fso.MoveFolder Source:=FromPath, Destination:=ToPath
MsgBox "The folder is moved from " & FromPath & " to " & ToPath
End Sub
Then, create a main Sub to run over the column "B" (from path) and Column "C" (to path), for instance:
Sub MainSub()
Dim CurrentFrom as Range, CurrentTo as Range
'get B2, assuming your B1 is a header, not a folder
Set CurrentFrom = ThisWorkbook.Worksheets("yoursheetname").Range("B2")
'get C2, assuming your C1 is a header
Set CurrentTo = ThisWorkbook.Worksheets("yoursheetname").Range("C2")
'get the actual values - paths - from cells
Dim ToPath as string, FromPath as string
ToPath = CurrentTo.value
FromPath = CurrentFrom.Value
'loop while your current frompath is not empty
Do while FromPath <> ""
'calls the move function from frompath to topath
Call Move_Rename_Folder(FromPath, ToPath)
'offsets the cells one row down
Set CurrentFrom = CurrentFrom.Offset(1,0)
Set CurrentTo = CurrentTo.Offset(1,0)
'gets the values of the new cells
FromPath = CurrentFrom.Value
ToPath = CurrentTo.Value
Loop
End Sub

Resources