I am new to VBA and this forum has been very helpful to me. I follow the threads posted on this forum to find answers to my questions and I would like to thank you all for providing awesome solutions.
I am currently working on generating a summarysheet from the excel files posted on SharePoint. I have mapped the sharepoint as a network drive. I am trying to open all files from sharepoint folder one after another, copy the required data from different tabs, paste it to summary sheet and close the file. When I try to run the code, it gives me a run time error 52 as 'bad file name or number'.
I have pasted the part of my code here. Any kind of help in this matter is really appreciated.
Thank you,
Pranav
Option Explicit
Sub GenerateSummary()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Directory As String
Dim MyFile As String
Dim SummarySheet As Workbook
Set SummarySheet = Workbooks.Add
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
MsgBox ("You did not select a folder")
Exit Sub
End If
Directory = .SelectedItems(1) & "\"
End With
MyFile = Dir(Directory & "*.xlsx")
Do While MyFile <> ""
Workbooks.Open (Directory & MyFile)
Sheets(Array(1, 2)).Select
Sheets(1).Activate
Sheets(Array(1, 2)).Copy Before:=SummarySheet.Sheets(1)
' Other statistics are calculated and operations are performed here
MyFile = Dir()
ActiveWindow.ActivateNext
ActiveWorkbook.Close
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Related
I'm using VBA and writing a macro trying to loop for all excel files in a specific user selected directory and I want to copy its content (which are tables in each excel file), but this error occurs when It's run the code and open the first excel file "Excel VBA run-time error 1004 : Application-defined or object-defined error". I didn't know what is the problem with it.
Here is the code
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
You need to qualify what context the Range("A1").Select etc. applies to. You have opened a workbook, but Excel does not know where the range is that you want to select. It could be in a different universe, because you never tell Excel that it is in the file you just opened.
To use a range in any workbook, you need to qualify it with the workbook and the worksheet. In some situations that is not required, because there is only one possible context, but here the code fails without these pointers. Try along these lines:
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
Dim ws as worksheet
set ws = wb.Sheets(1) ' or however you want to identify which sheet to use
Now you can use ws.Range() to address a range in the specified sheet.
You may also want to read up about how to avoid "Select" when manipulating Excel cells. There are many ways to replace your Select statements, for example the following code will replace the four lines you used to copy the populated range from A1 to the right and down.
ws.Range("A1").CurrentRegion.Copy
Good afternoon,
I would like to check all files in my directory.
For this purpose, I decided to loop through all of them.
The good code I found here:
https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder
and changed it consequently for my personal purpose.
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xlsm*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Change First Worksheet's Background Fill Blue
wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
but it looks like the code works for the first file only.
I am not only one with this problem, because I found the similar problems here:
VBA Loop through excel workbooks in folder and copy data - Not looping through all files
Excel-VBA Loop not looping through all files in folder
Is there a way to make this code working for all files instead of one?
or should I use better For Each instead of Do While ?
My problem is very similar to this issue:
Code Stopping While Looping through files on workbook.close
the new file is not prompted at all. In my VBA console is "no project selected"
I have seemingly the same code and it works fine.
When i pickup some code somewhere i tend to make small changes step by step and make sure its still working every change i make.
Sub LoopThroughFilesvieux()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xWB As Workbook
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
On Error Resume Next
Do While xFileName <> ""
Set xWB = Workbooks.Open(xFdItem & xFileName)
With xWB
'yourcode
End With
xWB.Close
xFileName = Dir
Loop
End If
End Sub
You can probably start again from my structure or the original structure you took that from and add your code lines little by little, also, try to run it step by step to see where it exits.
Problem:
A problem in making a cell reference in VBA for source workbook name. Error 9 subscripts out of range.
Task I am doing?
Ex. I have to copy 32 columns out of 50 columns from a workbook(Master) into a new workbook. I am able to make a code to copy and paste the column in the required sequence in new workbook.
The master workbook is a template of a register to take peoples information and it saved with a new name.
I have more than 65 workbooks(Master) to copy. I was trying to make a cell reference where I paste the source workbook(Master) name. I am aware that source workbook has to be open will running VBA.
I made icell as variable to fetch that value from cell B2, where I pasted workbook name but code is not running.
Code attached
Any suggestion is highly appreciated.
Sub Copy_Paste()
Dim iCell As String
iCell = Workbooks("Crack it").Worksheets("Intro").Range("B2").Value
'B2 will store the name of source workbook for copying data which will keep on changing
Workbooks("iCell").Worksheets("Register").Range("E2:E50").Copy
Workbooks("Crack it.xlsm").Worksheets("Risk").Range("A2").PasteSpecial Paste:=xlPasteValues 'Refid
Workbooks("iCell").Worksheets("Register").Range("H2:H50").Copy
Workbooks("Crack it.xlsm").Worksheets("Risk").Range("B2").PasteSpecial Paste:=xlPasteValues 'Tags
Workbooks("iCell").Worksheets("Register").Range("A2:A50").Copy
Workbooks("Crack it.xlsm").Worksheets("Risk").Range("c2").PasteSpecial Paste:=xlPasteValues 'Name
Workbooks("iCell").Worksheets("Register").Range("Z2:Z50").Copy
Workbooks("Crack it.xlsm").Worksheets("Risk").Range("D2").PasteSpecial Paste:=xlPasteValues 'Element
...... code keeps on repeating till column 32th
End Sub
I ahve somethign similar, I read all the files located on a folder for your case you will save all the 65 Workbooks in a folder, then read each one of them with a loop, once it takes the first book opened you will take the info:
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1) & sItem + "\"
FilePathBox.Value = sItem
End With
NextCode:
GetFolder = sItem & "\"
Set fldr = Nothing
If you see my code above it taks the url of the folder, then I will start a process that will see file by file:
Private Sub UserForm_Activate()
UserForm1.Top = (Application.Height / 2) - (UserForm1.Height / 2) + 45
UserForm1.Left = (Application.Width / 2) - (UserForm1.Width / 2) + 200
UserForm1.Label1.Visible = True
Label1.Caption = ""
'-----------------------------------------THIS IS THE LOOP OFR EACH FILE INTO THE FOLDER--------------------------------------------------
MyPath = UserForm2.FilePathBox.Value
Dim strFilename As String
strFilename = Dir(MyPath & "*.txt", vbNormal)
filesc = 1
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Application.DisplayAlerts = False
If filesc >= 1 Then
showBarName.Caption = showBarName.Caption & strFilename
'Worksheets.Add(Worksheets(Worksheets.Count)).Name = "Data"
Call ThisWorkbook.XY_Data((UserForm2.FilePathBox.Value & strFilename), (strFilename & ""))
showBarName.Caption = "Generating XY Data for %PATH%/"
End If
filesc = filesc + 1
counter = counter + cols
strFilename = Dir()
Loop
'------------------------------------------END--------------------------------------------------------------------------------------------
Worksheets("Spec").Visible = True
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Spec" Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
UserForm1.Hide
showBarName.Caption = "Saving File"
'THIS IS FOR XLSX
Application.StatusBar = "Save your file into the PNL Project path."
Application.DisplayAlerts = False
Dim hoja As Worksheet
For Each hoja In Sheets
If ActiveSheet.Name = "Data" Then
ActiveWindow.SelectedSheets.Delete
End If
Next hoja
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Workbooks (*.xlsx), *.xlsx")
If fileSaveName <> False Then
Application.ActiveWorkbook.SaveAs Filename:=fileSaveName, FileFormat:=51
End If
showBarName.Caption = "Generating XY Data for %PATH%/"
'This is to close the macro without saving
Application.StatusBar = "XY Data Generated by Yazaki <<erik.floresdelfin#mx.yazaki.com>>"
'ThisWorkbook.Close savechanges = False
Application.DisplayAlerts = True
End Sub
Then on the above code in some part I take each file in txt format, and I call a method which contains the url of the file that I want to open, the rest should be taking what tou need to copy and paste on the actual file, the final code I show is how to save the file asking to the user, sorry for the trash code but I think you caould manage taking what you need.
I have the following code that will open/save/close any/all workbooks in a folder. It works great, however, I also need it to include sub folders. The code needs to work without restrictions on the number of folders, sub folders and files, if possible.
I'm working with Excel 2010 and I'm new to VBA - would really appreciate any help!
Sub File_Loop_Example()
'Excel VBA code to loop through files in a folder with Excel VBA
Dim MyFolder As String, MyFile As String
'Opens a file dialog box for user to select a folder
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
MyFolder = .SelectedItems(1)
Err.Clear
End With
'stops screen updating, calculations, events, and statsu bar updates to help code run faster
'you'll be opening and closing many files so this will prevent your screen from displaying that
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'This section will loop through and open each file in the folder you selected
'and then close that file before opening the next file
MyFile = Dir(MyFolder & "\", vbReadOnly)
Do While MyFile <> ""
DoEvents
On Error GoTo 0
Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
ActiveWorkbook.Save
Workbooks(MyFile).Close SaveChanges:=True
MyFile = Dir
Loop
'turns settings back on that you turned off before looping folders
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlCalculationManual
MsgBox "Done!"
End Sub
For anyone interested, I found an alternative which I managed to adapt and does exactly what I want:
Sub Loop_Example()
Dim MyFolder As String
Dim file As Variant, wb As Excel.Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
MyFolder = .SelectedItems(1)
Err.Clear
End With
Application.ScreenUpdating = False
For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & startFolder & "*.xl*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
Set wb = Workbooks.Open(file)
ActiveWorkbook.Save
wb.Close SaveChanges:=True
Set wb = Nothing
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Edit: After user3561813 the suggestion of adding "/", it now read the first file. I have an out of range error message "9". It does read the first file correctly. Ultimately I am trying to open each file, and read the name and age (this is a testing not the real production form). And retrieve the values back to my main worksheet.
Original question
I am trying to read hundred of excel forms in a folder, read a particular cell position, and record them into my testing worksheet. I googled this tutorial and tried to write my code. But when I execute the Getting Folder function, selected a folder path, it does not loop the excel files I have. (or record their names)
'Source: https://www.youtube.com/watch?v=7x1T4s8DVc0
Sub GettingFolder()
Dim SelectedFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select folder"
.ButtonName = "Confirm"
.InitialFileName = "U:\"
If .Show = -1 Then
'ok clicked
SelectedFolder = .SelectedItems(1)
MsgBox SelectedFolder
' This is where I want to call my function
LoopFiles (SelectedFolder)
Else
'cancel clicked
End If
End With
End Sub
' Source: http://www.excel-easy.com/vba/examples/files-in-a-directory.html
Sub LoopFiles(path As String)
Dim directory As String, fileName As String, sheet As Worksheet
Dim i As Integer, j As Integer
' Avoid Screen flicker and improve performance
Application.ScreenUpdating = False
' Fixed per suggestion below..
directory = path & "\"
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
i = i + 1
j = 2
Cells(i, 1) = fileName
Workbooks.Open (directory & fileName)
For Each sheet In Workbooks(fileName).Worksheets
Workbooks("Testing.xlsm").Worksheets(1).Cells(i, j).Value = sheet.Name
j = j + 1
Next sheet
Workbooks(fileName).Close
fileName = Dir()
Loop
' Reset the screen update setting
Application.ScreenUpdating = True
End Sub
Interesting question! This should do it for you. Modify as needed.
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xlsx"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
Row = 1
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Change First Worksheet's Background Fill Blue
ThisWorkbook.Worksheets("Sheet1").Range("A" & Row).Value = Worksheets(1).Range("A1").Value
Row = Row + 1
'Save and Close Workbook
wb.Close SaveChanges:=True
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
In your code, the path variable may not contain a trailing backslash. This causes the following code in your LoopFiles(<>) SubRoutine to be inaccurate:
directory = path
fileName = Dir(directory & "*.xl??")
Filename would look something like: c:\users\name\documentshello.xlsx
Try changing the above code to:
directory = path & "\"
fileName = Dir(directory & "*.xl??")
Does that fix the problem?