Searching file names from list optimisation - excel

I'm currently trying to find files in a folder and move them into their seperate destination folders. I have a column of FILENAME next to a column of the respective FOLDER. The files are names as FILENAME_Ver_X and there should be 2 of each in the folder of different file types.
At the moment my code goes through each file, reads if it contains the FILENAME string and if so moves it to the folder. However this is quite slow as there is a massive number of files so I was wondering if there was a better way to search through it all.
Set objFolder = fso.GetFolder(Viewables)
Do While r <= maxRows
d = Rng(r, 1) & "_Ver_"
e = Rng(r, 2)
For Each f1 In objFolder.Files
If InStr(1, Left(f1.Name, Len(d)), d) > 0 Then
tPath = ActiveWorkbook.Path & "\" & e & "\"
fso.MoveFile (Viewables & f1.Name), tPath
End If
Next
r = r + 1
Loop

Maybe you just use vba to cycle through folder but then use windows level move command once per folder
The move command would allow wild cards so the vba could supply the original path and the move command logic
So you end up running the move command once per folder
You could get log the path and count of files in path before and after for auditing

Related

Auto-select all files in a folder to run a macro

I need a macro to automatically loop through files in a folder and copy certain values from these files. I have the copy part setup on manually selected files, but need to now automatically select them.
I already have a macro setup to loop through multiple files that the user selects. Except now, I'm trying to run it automatically and would like the macro to autoselect any files in a specified directory. How do I specify this directory? I've included my current code for manual selection.
Edit: I tried implementing the below answer, but I recieve an error saying that the file list is not in the format of an array. How do I overcome this?
FileNames = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*;*.csv*", MultiSelect:=True)
ii = 1
Do While ii <= UBound(FileName)
Set wbk = Workbooks.Open(FileName(ii))
'Multiple Loops
Wend
Maybe try :
Sub GetAllFileNames()
Dim FolderName As String
Dim FileName As String
FolderName = "C:\Users\sumit\Desktop\Test\" 'change your path
FileName = Dir(FolderName & "*.xls*") 'this one will browse only .xls if you want to browse all file see the note
Do While FileName <> ""
Debug.Print FileName
FileName = Dir()
Loop
End Sub
Note : FileName = Dir(FolderName) will browse you all files in folder.
If the the workbook is in the same folder than the file you want to browse you can select path like this :
FolderName = Application.ActiveWorkbook.Path & "\"

VBA comparing files before moving to another folder

I have been trying to use a code that ensures that there is a match from the input and output folders before moving input files into another folder. Here is a snippet:
'Select first Excel file within that Outlook_ImportedClaimsFiles folder path
OutlookImportFN = Dir(OutlookImportPath & "\*.xls")
'Select first Excel file within the SAS_Outputs folder path
SASOutputFN = Dir(SASOutputsPath & "\*.xls")
'Cycle through all files in the source folder path until there are no more left to cycle through
Do While OutlookImportFN <> ""
Counter = Counter + 1
'Create full path name of the source file
sFilePathName = OutlookImportPath & "\" & OutlookImportFN
'Create full path name of the destination file and add the date and time the file was moved
dFilePathName = OutlookRunPath & "\" & Format(Now, "yyyymmdd") & "_" & OutlookImportFN
The problem is that in the first folder (OutlookImportFN), there is a batch/holding file that contains the filenames for all the files in that folder that is used in the overall process. When flagging the first file, this file comes up first (this file shouldn't be flagged/selected at all). Because of this, when doing the comparison, the files don't match (unless I start with the 2nd file in the list). How do I either start with the 2nd file in the Input folder when comparing to the 1st file in the Output folder, or skip over this holding file in the Input folder when doing the comparison? I've tried a few things but nothing seems to work. Thanks in advance for your insight!
You need to add an If statement which makes sure the file isn't that batch file:
Do While OutlookImportFN <> ""
Counter = Counter + 1
If Not OutlookImportFN = "MyBatchFile" Then
'Create full path name of the source file
sFilePathName = OutlookImportPath & "\" & OutlookImportFN
'Create full path name of the destination file and add the date and time the file was moved
dFilePathName = OutlookRunPath & "\" & Format(Now, "yyyymmdd") & "_" & OutlookImportFN
End If

Using VBA to list folders and properties(date last modified)

I have a VBA Code listed below that lists all the folder names in a parent folder. I am trying to additionally list the folder properties in particular, 'Date Last Modified'. I know this is possible for files in a folder, but in this case, its the folders that I need this for.
I tried using FileSystemObject but I'm having problems with it not sure if my original code is the issue.
Can someone help me with direction as to what I can do next.
Here is my original code:
Sub GetFolders()
Dim path As String
Dim folder As String
Dim row As Integer
path = "\\C:bla bla\"
folder = Dir(path, vbDirectory)
row = 1
Do While folder <> ""
If (GetAttr(path & folder) And vbDirectory) = vbDirectory Then
Cells(row, 1) = path & folder
row = row + 1
End If
folder = Dir()
Loop
End Sub
FileDateTime() can do this.
Inside the loop:
Cells(row, 1) = path & folder
If (folder <> "." And folder <> "..") Then
Cells(row, 2) = FileDateTime(path & folder)
End If
row = row + 1

Self creating workbook with automatic save in new created folder

I have an Excel form that I need really often with other file names and changed data in the forms. I need to write code that creates a folder and saves the Excel file in it with the changed text in the form. (the text is in another Excel file)
What I have:
I have an Excel file with a list of names, numbers and text that I need to fill in my empty form.
I have a form where I have to write that stuff in, at the moment manually.
I know how I could get my data in my form, but I don't know how I can change the data so it kinda loops through and saves it.
I know how to save an Excel file but I'm not sure if its the best way, because I don't need any macros in the freshly saved form.
The end result should be that all the Excel forms get saved in a path that the user decides or where the Excel macro file is in. The Excel files should be in a folder that has the same name as the form.
Plese help me with ideas how I can realise this.
I found this code to create folders but I'm not sure how I could bind it in that it saves only the files in that have the same name.
Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub

excel vba move multiple files using listbox

I have created a form with three list boxes. The first loads with the files in a selected folder. I then select several files in the first list and move them into the second list box. The files in the second list box now need to be copied into folders listed in the third list box. All the issues of setting the source and destination paths are done. I need the lines of code which cause the selected files in the second list to be copied to the selected destination in the third list box.
Sample code:
FileToCopy = FileSourceDirectory & lstSelectedFiles.Value
DestinationFolderName = UserRepositoryDirectory & lstRepositoryFolders
CopiedFile = DestinationFolderName & "\" & lstSelectedFiles.Value
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
FileCopy FileToCopy, CopiedFile Unload frmCopyFileToRepository
Dim i As Integer
For i = 0 To lstSelectedFiles.ListCount - 1
FileToCopy = FileSourceDirectory & lstSelectedFiles.List(i)
CopiedFile = DestinationFolderName & "\" & lstSelectedFiles.List(i)
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
FileCopy FileToCopy, CopiedFile
Next i

Resources