So I was trying to create a list of excel files in a folder (file name and path) and then use a For loop to copy and paste a specified worksheet for all of the files listed into a specified worksheet in the excel workbook that contains the macro. So far everything works except for the fact that the same file keeps getting copied and pasted over instead of all the files. The macro loops for the correct number of times, but it's not using all the excel files.
Here's the code:
First part for listing the files in the folder
Private Sub btn_LeaveReport()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\Administration\Time Sheets")
i = 2
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 2) = objFile.Name
'print file path
Cells(i + 1, 3) = objFile.Path
i = i + 1
Next objFile
End Sub
and this is the part for the loop
Private Sub btn_PullData()
'Declared Variables
Dim wbk As Workbook
Dim i As Integer
Dim StartAt As Integer
Dim EndAt As Integer
Dim CopyPath As String
Dim CopyPathRow As Integer
Dim iRow As Integer
'Ranges
StartAt = 1
EndAt = Val(ThisWorkbook.Worksheets("LeaveReport").Range("A1"))
CopyPathRow = 3
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
iRow = 3
'Loop de loop
For i = StartAt To EndAt
Application.ScreenUpdating = False
Set wbk = Workbooks.Open(CopyPath)
Sheets("TIMESHEET").Select
Range("C12:S34").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Pastebin").Select
Range("a" & iRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
iRow = iRow + 39
CopyPathRow = CopyPathRow + 1
wbk.Close True
Next i
Sheets("Pastebin").Select
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
MsgBox "Timesheet Data Imported"
End Sub
Based on the source of the error, i.e. same file being used, I'm guessing the issue lies with the part that has this:
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
and is "supposed" to update in the For loop via this:
CopyPathRow = CopyPathRow + 1
Move the line
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
Inside the loop, that value of CopyPath is never being changed, but the value of CopyPathRow is.
Edit: I wouldn't call this recursion either.
Related
This is the first week I learn vba so bear with me if I have a lot of questions;-)
So I have two folders, one folder contains the templates I need to update, the other contains the reports that the updates will be copied from. Cell A1 in each template contains the code that is specific to that BU. I need vba to find the code in the file names in the report folder and open that report. The problem is that the report names have different lengths, eg. it's named as XXX region_code_XXXXXXXXXXX, there can be any number of "X" before and after the code.
Sub Macro1()
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder("C:\Users\35264\summary\test")
For Each file In ff.Files
Workbooks.Openfile
Set wbk2 = ActiveWorkbook
Sheets("Summary").Select
Range("A1").Select
rngX = Range("A1").Value
Now I need to find rngX in the file names in the report folder... I can't figure out how. Let me know if anyone can help! Thank you!
I am learning how to use dir function. I think it will be helpful to get the names of the reports first.
Combine the FileSystemObject Object With the Dir Function
Dir cannot be used in nested Do...Loops.
Using the FileSystemObject object, it opens files in one folder and uses the information in it to open specific files in another folder by using the Dir function. For each combination, it prints their names to the immediate window and closes each file without saving changes.
A better way to do this would be to write the file paths of the first folder to an array by using the Dir function and then loop through the elements of the array to open each file... etc.
Option Explicit
Sub PrintTemplatesAndReports()
' Templates
Const tFolderPath As String = "C:\Users\35264\summary\templates\"
Const tWorksheetName As String = "Summary"
Const rFilePatternAddress As String = "A1"
Const tFileExtensionLeft As String = "xls"
' Reports
Const rFolderPath As String = "C:\Users\35264\summary\reports\"
Const rFileExtensionPattern As String = ".xls*"
' 1st Worbook (ThisWorkbook)
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(tFolderPath) Then Exit Sub
If Not fso.FolderExists(rFolderPath) Then Exit Sub
Dim fsoFolder As Object: Set fsoFolder = fso.Getfolder(tFolderPath)
' Templates (using the FileSystemObject object)
Dim fsoFile As Object
Dim twb As Workbook, tws As Worksheet
Dim tExtension As String, tFilePath As String
' Report (using Dir)
Dim rwb As Workbook
Dim rFilePattern As String, rFileName As String, rFilePath As String
' Counters
Dim ttCount As Long, tCount As Long, rCount As Long
For Each fsoFile In fsoFolder.Files
ttCount = ttCount + 1
tExtension = fso.GetExtensionName(fsoFile)
If InStr(1, tExtension, tFileExtensionLeft, vbTextCompare) = 1 Then
tCount = tCount + 1
tFilePath = tFolderPath & fsoFile.Name
' 2nd Workbook (Template)
Set twb = Workbooks.Open(tFilePath)
On Error Resume Next
Set tws = twb.Worksheets(tWorksheetName)
On Error GoTo 0
If Not tws Is Nothing Then
rFilePattern = CStr(tws.Range(rFilePatternAddress).Value)
rFileName = Dir(rFolderPath, "*" & rFilePattern _
& "*" & rFileExtensionPattern)
Do Until Len(rFileName) = 0
rCount = rCount + 1
rFilePath = rFolderPath & rFileName
' 3rd Workbook (Report)
Set rwb = Workbooks.Open(rFolderPath, rFileName)
' Do your thing, e.g.:
Debug.Print twb.Name, rwb.Name
rwb.Close SaveChanges:=False
rFileName = Dir ' next report
Loop
Set tws = Nothing
End If
twb.Close SaveChanges:=False
End If
Next fsoFile ' next template
MsgBox "Template files processed: " & tCount & "(" & ttCount & ")" _
& vbLf & "Report files processed: " & rCount & "(" & tCount & ")", _
vbInformation
End Sub
I created a macro to rename files, but received this error:
Run-time error 53 File not found
But if I keep my cursor, it picks my location path correctly
"Name folder & Curname As folder & Newname"
Sub getname()
Dim folder As String
mfolder = Sheets("Sheet1").Cells(1, 2).Value
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
i = 3
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(mfolder)
For Each objFile In objFolder.Files
Sheets("Sheet1").Cells(i, 1).Value = objFile.Name
i = i + 1
Next objFile
End Sub
Sub reName()
Dim mfolder As String
Dim CurName As String
Dim NewName As String
Dim i As Integer
i = 3
mfolder = Sheets("Sheet1").Cells(1, 2).Value
Do While Sheets("Sheet1").Cells(i, 1).Text <> "" And Sheets("Sheet1").Cells(i, 2).Text <> ""
CurName = Sheets("Sheet1").Cells(i, 1).Text
NewName = Sheets("Sheet1").Cells(i, 2).Text
Name mfolder & CurName As mfolder & NewName
i = i + 1
Loop
MsgBox ("Complete")
End Sub
As a rule of thumb I would always use early binding of Microsoft scripting runtime. This gives you access to intellisense and other benefits when using external references.
Tools >> references
Once added you import the object reference as follows.
dim fso as filesystemobject
set fso = new filesystemobject
this allows you to do things like this.
dim fldr as fldr
set fldr = fso.getfolder("c:\test_folder")
and iterating through files
dim fl as file
for each fl in fldr.files
do something
next fl
It always helps me personally to see what options are available when using a new reference in VBA .
(when using late binding like you are you don't have this luxury)
and mainly renaming files
fldr.move("C:\test_folder2")
In my opinion you should store the path of the file
objFile.path not objFile.Name
this would store something like C:\test\test.text
so fix with getting the list of files
Function list_files():
' log all files
Dim fso As filesystemobject
Set fso = New filesystemobject
Dim fldr As fldr
Set fldr = fso.getfolder("c:\test_folder")
Dim fl as file
Dim ws As Worksheet
Set ws = Worksheets("sheet1")
Dim i As Integer
i = 2
For Each fl In fldr.Files
ws.Cells(i, 1) = fl.Path
Next fl
End Function
and renaming
Function rename_files():
' log all files
Dim fso As filesystemobject
Set fso = New filesystemobject
Dim fl As file
Dim ws As Worksheet
Set ws = Worksheets("sheet1")
Dim lr As Integer
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lr
If ws.Cells(x, 2) <> "" Then
Set fl = fso.getfile(ws.Cells(x, 1))
fl.Move (ws.Cells(x, 2))
End If
Next x
End Function
Something else to note is that when iterating through cells its always best practice to use something along the lines of this.
dim ws as worksheet
set ws = worksheets("Sheet1") ' get the worksheet
dim lr as integer ' create lr interger reference
lr = ws.cells(rows.count,1).end(xlup).row
for x = 2 to lr
'do something
next x
lets break down whats happening here.
ws.cells(rows.count,1).end(xlup).row
ws in the worksheet
cells in the cells
rows.count get the last row
1 in column one
so....
ws.cells(rows.count,1) is referencing ALL cells in column 1
then....
.end(xlup) goes upwards to where the data starts (or the blank lines end)
row logs the row number
Then when you do your for loop you are not checking for the empty cells as you already know where it is.
for x = 2 to lr 'the last row in the data with data in it.
if ws.cells(x,2) <> "" then
'do something because column 1 and 2 both have no value in the cell
end if
next x
hope this helps somewhat
I have a master Excel file which will be used as a reference to get the data from different sheet names from different Excel files in a folder,
I've searched the net and could not get a solution. Is there a way to get all the sheet names and paste it per row starting from A2 and A1 and which will reflect its file name without the extension?
Here is what I have so far:
Sub SheetNames()
Columns(1).Insert
For I = 1 To Sheets.Count
Cells(I, 1) = Sheets(I).Name
Next I
End Sub
You can try this code. It will save everything in first sheet of your master workbook:
Sub SheetNames()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim currentWorkbook, wb As Workbook
Dim i, j As Integer
Set currentWorkbook = ActiveWorkbook
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the current folder object
Set objFolder = objFSO.GetFolder(currentWorkbook.Path)
i = 1
j = 2
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'we filter filenames, so we get only excel files
'note that second condition is to prevent from using cached workbook associated with opened workbook
'it starts with ~$
If objFile.Name Like "*.xlsx" And Not objFile.Name Like "~$*.xlsx" _
And Not objFile.Name = currentWorkbook.Name Then
'get the name of a workbook in the first row
currentWorkbook.Worksheets(1).Cells(1, i).Value = objFile.Name
'open workbook
Set wb = Workbooks.Open(currentWorkbook.Path & "/" & objFile.Name)
'loop through sheets and get their names into cells
For j = 2 To wb.Worksheets.Count + 1
currentWorkbook.Worksheets(1).Cells(j, i).Value = wb.Worksheets(j - 1).Name
Next
'close workbook without saving changes
wb.Close (False)
i = i + 1
End If
Next objFile
End Sub
I'm trying to create a range name in a number of excel files, and then write the file names and paths out to another excel. The files/paths are written correctly, but the range name doesn't appear to be created in the file. Can you tell me where I'm going wrong?
Sub directlisting()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim cell As Range
Dim RangeName As String
Dim CellName As String
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("\\xxxxxxxxxxx\testdata\Transfer")
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'open file if an Excel file
If Right(objFile, 4) = "xls*" Or Right(objFile, 3) = "xl*" Then
Application.Workbooks.Open (objFile)
'create range name
RangeName = "PVS"
CellName = "A4:AG27"
Set cell = Worksheets("PVS").Range(CellName)
objFile.Names.Add Name:=RangeName, RefersTo:=cell
'Save the file
Application.DisplayAlerts = False
objFile.Save
objFile.Close
Application.DisplayAlerts = True
End If
'print file name
Cells(i + 1, 1) = objFile.Name
'print file path
Cells(i + 1, 2) = objFile.path
i = i + 1
Next objFile
End If
End Sub
I tested this and it seemed to work for me. The main idea was to be more explicit with the workbook/worksheets and what you're calling them on:
Sub directlisting()
Dim objFSO As Object, objFolder As Object, objFile As Object
Dim cell As Range
Dim RangeName As String, CellName As String
Dim i As Integer
Dim tempWB As Workbook, mainWB As Workbook
Dim mainWS As Worksheet
'Assuming this is running from a "main" workbook
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.ActiveSheet
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\User\Documents\Test") ' CHANGE TO YOUR PATH
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'open file if an Excel file
If Right(objFile, 4) = "xlsx" Or Right(objFile, 3) = "xl*" Then
Set tempWB = Application.Workbooks.Open(objFile)
'create range name
RangeName = "PVS"
CellName = "A4:AG27"
Set cell = tempWB.Worksheets("PVS").Range(CellName)
'ActiveWorkbook.Names.Add Name:="PVS", RefersToR1C1:="=PVS!R11C8:R18C14"
tempWB.Names.Add Name:=RangeName, RefersTo:=cell
'print file name
mainWS.Cells(i + 1, 1) = tempWB.Name
'print file path
mainWS.Cells(i + 1, 2) = tempWB.Path
i = i + 1
'Save the file
Application.DisplayAlerts = False
tempWB.Save
tempWB.Close
Application.DisplayAlerts = True
End If ' Right (objFile, 4) ...
Next objFile
End Sub
Small note: I had to change the ... = "xls*" Or Right ... to ... = "xlsx" Or ..., because for some reason it wouldn't open the .xlsx file. Curious. In any case, let me know if you get any errors or weird issues!
Also, I moved the part where you save the workbook name and path inside the If statement, so only if the file opens, will it mark it. Just tweak that line if you want to note every file, whether or not it opens.
Is there a way to list file names across different directories in an excel sheet, with links (so one can click on the link beside the file name and the file would open)?
I'm ready to write a script, but I don't know of any particular method or command.
I don't want to be typing the whole thing.
I don't care about directory/tree structure, but file link should be present.
There is one directory which contains lots of other folders which contain the files I need to list, mostly *.pdf's.
Any help appreciated. Thanks!
You can use below code to get File name and File path Set main folder to strFolderPath
'Global Declaration for Start Row
Public lngRow As Long
Sub pReadAllFilesInDirectory()
Dim strFolderPath As String
Dim BlnInclude_subfolder As Boolean
'Set Path here
strFolderPath = "C:\"
'set start row
lngRow = 1
'Set this true if you want list of sub-folders as well
BlnInclude_subfolder = True
'---------- Reading of files in folders and sub-folders------
Call ListMyFiles(strFolderPath, BlnInclude_subfolder)
'---------- Reading of files in folders and sub-folders------
End Sub
Sub ListMyFiles(mySourcePath As String, blnIncludeSubfolders As Boolean)
Dim MyObject As Object
Dim mySource As Object
Dim mySubFolder As Object
Dim myfile As Object
Dim iCol As Long
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set mySource = MyObject.GetFolder(mySourcePath)
'Loop in each file in Folder
For Each myfile In mySource.Files
iCol = 1
Sheet1.Cells(lngRow, iCol).Value = myfile.Name 'File Name
iCol = iCol + 1
Sheet1.Cells(lngRow, iCol).Value = myfile.Path 'File Path/Location
lngRow = lngRow + 1
Next
If blnIncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub
A quick seach yielded this answer I believe you are looking for.
Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\Stuff\Business\Temp")
i = 1
'loops through each file in the directory
For Each objFile In objFolder.Files
'select cell
Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
'create hyperlink in selected cell
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
objFile.Path, _
TextToDisplay:=objFile.Name
i = i + 1
Next objFile
End Sub