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 & "\"
Related
I'm trying to open all MS Project files in a specific folder to extract some information of each one and transfer to excel.
Sub OpenProjectFiles()
Dim myMpp As MSProject.Application
Dim FileNameMpp As String, Folder As String
Folder = "C:\Users\nikolasqueiroz\Desktop\VBA Test"
Set myMpp = CreateObject("Msproject.Application")
FileNameMpp = Dir(Folder & "\*.mpp")
Do
myMpp.FileOpenEx Name:=FileNameMpp, ReadOnly:=True
FileNameMpp = Dir
Loop Until FileNameMpp = " "
End Sub
But when I try to open the .mpp file something goes wrong:
Does anyone know how can I fix this?
First of all, the code you posted does not match the code shown in your screenshot. The screenshot code uses the syntax for opening files from Project Server--e.g. prefacing the name of the file with <>\.
Use this code instead:
Sub OpenProjectFiles()
Dim myMpp As MSProject.Application
Dim FileNameMpp As String, Folder As String
Folder = "C:\Users\nikolasqueiroz\Desktop\VBA Test\"
Set myMpp = CreateObject("Msproject.Application")
myMpp.Visible = True
FileNameMpp = Dir(Folder & "*.mpp")
Do While Len(FileNameMpp) > 0
myMpp.FileOpenEx Name:=Folder & FileNameMpp, ReadOnly:=True
FileNameMpp = Dir
Loop
End Sub
Notes:
When automating another application, make it visible so you can see & respond to pop-up messages.
The FileOpenEx method should be given the full path.
Test the output of the Dir function at the beginning of the loop as there may not be any files.
Adding the trailing slash in the Folder variable is simpler & cleaner than adding it later (in two places).
I'm trying to better understand the Dir function. I have a Dir loop to take action on all .csv files in the directory, but when the loop comes across another file type, like .txt, it will error instead of moving on to the next .csv. item.
This is the relevant portion of my code.
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
strWorkbook = Dir(strSourceExcelLocation & "*.csv*")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport)
'Get next workbook
strWorkbook = Dir
'Close Excel workbook without making changes
wbktoExport.Close False
Loop
So if there are only .csv files in the directory, then this works fine. When it comes across another file type, an error occurs.
The error is on line
strWorkbook = Dir
Run-time error 5: Invalid procedure call or argument
Am I missing something with the way I use the wildcards in the .csv at the beginning?
Thank you
Solved my issue.
The problem seems to have been because when I called another procedure, I had another Dir in that sub to create a new folder if one didn't already exist. So basically I had a Dir in a Dir, which apparently is bad.
I moved the folder creation part to the very beginning of my procedure, so it is executed before I begin the Dir for looping through all the CSV files.
Option Explicit
Sub Loop_Dir_for_Excel_Workbooks()
Dim strWorkbook As String, wbktoExport As Workbook, strSourceExcelLocation As String, fldr As String, strTargetPDFLocation As String, d As String
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\"
'***** Creating a folder to save the PDFs in. Naming the folder with today's date *****
d = Format(Date, "mm-dd-yyyy")
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\" & d & "\"
If Len(Dir(strTargetPDFLocation, vbDirectory)) = 0 Then MkDir strTargetPDFLocation
fldr = InputBox("Input the EXACT Folder Name that you want to create PDFs for")
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
'Search all Excel files in the directory with .xls, .xlsx, xlsm extensions
strWorkbook = Dir(strSourceExcelLocation & "*.csv")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport, strTargetPDFLocation)
'Close Excel workbook without making changes
wbktoExport.Close False
'Get next workbook
strWorkbook = Dir
Loop
End Sub
Try to hardcode the path and give it a try again. Probably the error is something really small in the hardcoding. E.g., in the code below, replace C:\Users\username\Desktop\AAA\ with the path of the file. Then run it. Do not forget the last \. It should work:
Sub TestMe()
Dim workbookPath As String
workbookPath = Dir("C:\Users\username\Desktop\AAA\" & "*.csv")
Do While Len(workbookPath) > 0
Debug.Print workbookPath
workbookPath = Dir
Loop
End Sub
I have 2 different folder locations a template folder that contains 40 template excel files, which contain premade formulas.. These files are saved as template_2D, template_3D ect, however 30 files depend on one file that will be open called 'srtData.xslx' and the other 10 pull data from the 30 open.
Then I want to refresh all (as all depend on one another) then I want to save all 40 files down in a different location with their name without the template. eg. 2D, 3D ... but in a different location and then close all template files aswell as these saved files. SO the template files will not have changed, all that will happen is the refresh version has been saved down in a different folder location.
I am very basic with VBA so bare with.
So far, all I have is
Sub OpenAllWorkbooks()
Dim fldrpath As String
fldrpath = "R:\Sam\"
'Step 1:Declare your variables
Dim MyFiles As String
'Step 2: Specify a target folder/directory, you may change it.
MyFiles = Dir(fldrpath & "*.xlsx")
Do While MyFiles <> ""
'Step 3: Open Workbooks one by one
Workbooks.Open fldrpath & MyFiles
'Step 4: Next File in the folder/Directory
MyFiles = Dir
Loop
End Sub
However I think by doing this I have no idea how I will save all in a different folder
This is the solution I used, folllowing the comments above:
Sub OpenAllWorkbooks()
Dim wb as Workbook
Dim fldrpath As String
fldrpath = "R:\Sam\"
'Step 1:Declare your variables
Dim MyFiles As String
'Step 2: Specify a target folder/directory, you may change it.
MyFiles = Dir(fldrpath & "*.xlsx")
Do While MyFiles <> ""
'Step 3: Open Workbooks one by one
Set wb = Workbooks.Open (fldrpath & MyFiles)
wb.SaveAs path,fileformat
'Step 4: Next File in the folder/Directory
MyFiles = Dir
Loop
End Sub
I have created a VBA macro that pulls files from folder/subfolders based on a number of parameters. This includes finding zip folders that meet those parameters and copying them to a new directory so that each file can be searched through also. The problem that I'm having is that many of the files in those zips are duplicates, and as the project is to be automated, I cannot sit there and push the don't copy button every time it pops up. Is there a way to search through zip files and ignore the duplicate files? What I have for this part of my code is:
Sub Unzip(fileName As String, mainSubfolder As String)
Dim sourceDir As String, fileString As String
Dim FileNameFolder As Variant
Dim oApp As Object
sourceDir = "\\Filesrv02\depts\AR\EDIfiles\Remits"
fileString = mainSubfolder + fileName
If Right(sourceDir, 1) <> "\" Then
sourceDir = sourceDir & "\"
End If
FileNameFolder = sourceDir & "Unzipped"
If Dir(FileNameFolder, vbDirectory) = vbNullString Then
MkDir FileNameFolder
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fileString).Items
End Sub
The last two lines are where I copy files from the zip folder into a new folder called "Unzipped". However, I'm not sure how to get at each individual file in the zip folder to say if it already exists, ignore it. Any suggestions would be greatly appreciated!
Maybe this helps:
(taken from: https://stackoverflow.com/a/14987890/3883521)
With oApp.NameSpace(ZipFile & "\")
If OverwriteFile Then
For Each fil In .Items
If FSO.FileExists(DefPath & fil.Name) Then
Kill DefPath & fil.Name
End If
Next
End If
oApp.NameSpace(CVar(DefPath)).CopyHere .Items
End With
Very new to this so please help. Im trying to mass update files in a static folder location, many files in one folder.
What i want to do is
run VBA macro in Excel 2010 to goto a network location folder,
open the first file in the folder.
Unprotect the workbook and worksheets call another marco to run changes
then protect the worksheet close the file
and then move onto the next file in the folder until all files have been corrected.
I have created the marco to make the changes, this is called "Edit"
File types are xlsm and the workbook and worksheet are password protected How can i automatically run the macro to goto the network location and in series open each file, unprotect, call the macro, then re protect the document close file and move onto the next file until they are all updated.
Sub Auto_open_change()
Dim WrkBook As Workbook
Dim StrFileName As String
Dim FileLocnStr As String
Dim LAARNmeWrkbk As String
PERNmeWrkbk = ThisWorkbook.Name
StrFileName = "*.xlsx"
FileLocnStr = ThisWorkbook.Path
Workbooks.Open (FileLocnStr & "\" & StrFileName)
Workbooks(StrFileName).Activate
With Application.FindFile
SearchSubFolders = False
LookIn = "Network location"
Filename = "*.xlsm"
If .Execute > 0 Then
Debug.Print "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
WrkBook.Worksheets(1).Select
ThisWorkbook.Worksheets(1).Cells(DestinationRange) = WrkBook.Worksheets(1).Cells(SourceRange).Value
Next i
Else
Debug.Print "There were no files found."
End If
Im managing to unprotect the file update and reprotect the file fine, just cant get the file from the network location.
I'm using Excel 07, which doesn't allow Application.FindFile, so I can't test this. However, I believe the issue may be that you need to Set the variable Wrkbook, not just assign it.
Change
WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
to
Set WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
and let me know how that turns out!