Upload csv files from a directory to a folder using VBA - excel

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

Related

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.

Move only files with matching files names from one folder to another folder

I want to copy only the files from one folder “the FromPath” that have the same file name (with different extensions) as in another folder the “the ToPath”. Only the shared file named files will be moved. I think the code would have to first look in the ToPath folder to get the names of the files and then cross reference those in the “FromPath” folder.
Thanks
Private Sub CmdBtn_transfer_Click()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim Val As String
Dim i As Integer
FromPath = "C:\Users\rossi\Desktop\Production files\" & (Me.ListBox1) '<< Change
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
Val = ListBox2.List(i)
End If
Next i
FileExt = "*.sli*" '<< Change
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) Then
ToPath = "\\bego.hb\MED_PRODUCTION\USA_Datapreparation\" & (Me.ListBox2.List(i)) '<< Change
If Right(ToPath, 1) <> "\" Then
ToPath = ToPath & "\"
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End If
Next i
End Sub
You pretty much have it. I made a couple of small additions. First I make a unique list of local files in the colFiles collection. I did this because you are copying to a remote server. I think it will probably be quicker this way. Once you have the list of local files, you simply loop through the collection checking to see if they exist in the remote folder, and copy them if they do.
Private Sub CmdBtn_transfer_Click()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim Val As String
Dim i As Integer
Dim x As Integer
Dim colFiles As New Collection
Dim strFilename As String
FromPath = "C:\Users\rossi\Desktop\Production files\" & (Me.ListBox1) '<< Change
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
Val = ListBox2.List(i)
End If
Next i
FileExt = "*.sli*" '<< Change
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
'Create a list of local filenames
strFilename = Dir(FromPath & "*" & FileExt) 'Corrected
While strFilename <> ""
colFiles.Add Left(strFilename, _
InStr(1, strFilename, ".", vbBinaryCompare) - 1), _
Left(strFilename, InStr(1, strFilename, ".", vbBinaryCompare) - 1)
strFilename = Dir()
Wend
Set FSO = CreateObject("scripting.filesystemobject")
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) Then
ToPath = "\\bego.hb\MED_PRODUCTION\USA_Datapreparation\" & (Me.ListBox2.List(i)) '<< Change
If Right(ToPath, 1) <> "\" Then
ToPath = ToPath & "\"
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If
'Now loop through our list of files to see if they exist on the remote server
For x = 1 To colFiles.Count 'Corrected
If FSO.FileExists(ToPath & colFiles.item(x) & FileExt) Then
FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
End If
Next
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End If
Next i
End Sub

How to use multiple selections from VBA Userform Multiselect Listbox in path

I have created a VBA userform, by manipulating code i found from a website, for coworkers to transfer files from selected folder from one listbox to another folder in a second listbox. The folders that populate in the listboxes change daily. It works fine for both listboxes with fmSingleSelect but i cannot figure out how to run it properly with a fmMultiSelect property on the second listbox (Yes, i changed the property to fmMultiSelect on the second listbox).
It would save time to be able to multiselect the projects folder and run the transfers simultaneously.
Below is the code for single select and commented out some code i was working with for multiselect
Also an image is below code
Thanks
Private Sub CmdBtn_transfer_Click()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim Value As String
Dim i As Integer
FromPath = "C:\Users\us-lcn-dataprep03\Desktop\Production files\" & (Me.ListBox1) '<< Change
ToPath = "\\bego.hb\MED_PRODUCTION\USA_Datapreparation\" & (Me.ListBox2) '<< Change
' For i = 0 To ListBox2.Items.Count - 1
' If ListBox2.Items(i).Selected = True Then
' Val = ListBox2.Items(i).Value
' End If
'Next i
FileExt = "*.sli*" '<< Change
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
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
FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub
Userform list boxes
The following code is a "minimal change" alteration to your code so that it should handle copying the files from one directory to multiple directories:
Private Sub CmdBtn_transfer_Click()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim Value As String
Dim i As Integer
FromPath = "C:\Users\us-lcn-dataprep03\Desktop\Production files\" & (Me.ListBox1) '<< Change
FileExt = "*.sli*" '<< Change
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) Then
ToPath = "\\bego.hb\MED_PRODUCTION\USA_Datapreparation\" & (Me.ListBox2.List(i)) '<< Change
If Right(ToPath, 1) <> "\" Then
ToPath = ToPath & "\"
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End If
Next i
End Sub
All I did was move your commented out code re looping through the selected items in ListBox2 so that it was wrapped around the parts of the code which are affected by the ToPath. (Note: The MsgBox is within the loop - you may wish to move it outside the loop but, if you do, you may want to make the message more generic - e.g. "Your files have been moved as requested".)
I also corrected some mistakes in your commented code:
ListBox2.Items.Count should be ListBox2.ListCount
ListBox2.Items(i).Selected should be ListBox2.Selected(i)
ListBox2.Items(i).Value should be ListBox2.List(i)

Excel macro to move all subfolders to another location

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

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

Resources