I'm writting a VBA Macro in Excel that should o the following:
Given a following path loops through the subfolders in that path (all subfolders begin with a sequencial number)
Goes inside the subfolder which are in a numerical window defined as input (Start_i=76, Finish_i=106 for instance) and searches for the excel file (.xlsx or .xlsm) which has the same name as that subfolder
Open it, change some specifc cells, saves and close the file
Proccede to the next subfolder in the window [76, 106]
So far so good.
Problem, I have a folder with 2 files (.pdf and .xlxs) and teh program returs my 3 files (.pdf and 2x .xlxs)
Option Explicit
Sub BaKo_Check()
Dim Name As String, Fa As String, Anlage As String, projekt As String, auxStringPath As String
Dim Datum As Date
Dim BeMi As Integer, Start_i As Integer, Finish_i As Integer, BaKo_Nr As Integer
Dim FSO As New FileSystemObject
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim file As Object
Dim fileName As String
'Get Data from Input Window
Fa = Range("I2").Text
projekt = Range("I3").Text
Name = Range("I4").Text
Datum = Range("I5").Value
Start_i = ThisWorkbook.Sheets("Sheet1").Range("I10").Value
Finish_i = ThisWorkbook.Sheets("Sheet1").Range("I11").Value
auxStringPath = Range("I8").Text
'Error Control
If auxStringPath = "" Then
Err = 19
GoTo handleCancel
End If
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(auxStringPath)
'Loop through subfolders in main Folder
For Each objSubFolder In objFolder.subfolders
BaKo_Nr = CInt(Left(objSubFolder.Name, 3))
If BaKo_Nr >= Start_i Then
If BaKo_Nr <= Finish_i Then
'Loop trough Files in SubFolders
For Each file In objSubFolder.Files
fileName = FSO.getfilename(CStr(file))
If FSO.GetExtensionName(CStr(file)) = "xlsx" Or FSO.GetExtensionName(CStr(file)) = "xlsm" Then
Workbooks.Open fileName:=file
Workbooks(fileName).Sheets("BaKo_neu").Range("C4").Value = projekt
Workbooks(fileName).Sheets("BaKo_neu").Range("C53").Value = Name
Workbooks(fileName).Sheets("BaKo_neu").Range("C54").Value = Datum
Workbooks(fileName).Sheets("BaKo_neu").Range("H2").Value = Fa
Workbooks(fileName).Sheets("BaKo_neu").Range("H4").Value = Mid(fileName, 10, 6)
ThisWorkbook.Sheets("Sheet1").Range("E23").Value = Mid(fileName, 10, 6)
Workbooks(fileName).Sheets("BaKo_neu").Range("C2").Value = ThisWorkbook.Sheets("Sheet1").Range("F23").Value
Workbooks(fileName).Save
Workbooks(fileName).Close
End If
Next file
End If
End If
Next objSubFolder
handleCancel:
If Err = 19 Then
MsgBox "Missing Path"
End If
End Sub
The code function for the 1st and 2nd files, but when it goes to the 3rd it crashes...
Can someone help me out?
Many Thanks
Thanks Tim, solved my problem.
I've integrated a line with the attributes specification and it runs smoothly:
For Each file In objSubFolder.Files
fileName = FSO.getfilename(CStr(file))
*If file.Attributes <> 32 Then Exit For*
Related
I have the following script. Want the number of folder, subfolders and files:
Sub CountFiles(ByVal path1 As String)
Dim fso As Object
Dim subfolder As Object
Dim file As Object
Dim folder As Object
Dim stetje As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path1)
For Each subfolder In folder.SubFolders
CountFiles (subfolder.path)
Next subfolder
For Each file In folder.Files
Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = file.path
Next file
Set fso = Nothing
Set folder = Nothing
Set subfolder = Nothing
Set file = Nothing
End Sub
Which you call as:
Sub someStuff()
Call CountFiles ("c:/temp/test/")
End Sub
This script writes into Excel cells paths to all the folders, subfolders and files
But what I really want is to count the TOTAL of all the the occurrences into a variable.
So instead of this:
For Each file In folder.Files
Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = file.path
Next file
I would like something like this:
For Each file In folder.Files
number = number + file.path.Count // of course this line is completely pseudo
Next file
So the wanted output is for example the number: 2345 and not 2345 rows with paths written out.
Any help / hints would be appreciated!
Here's a way to do it:
Function CountFiles(ByVal path As String) As Long
Dim fso As Object
Dim folder As Object
Dim subfolder As Object
Dim amount As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
For Each subfolder In folder.SubFolders
amount = amount + CountFiles(subfolder.path)
Next subfolder
amount = amount + folder.Files.Count
Set fso = Nothing
Set folder = Nothing
Set subfolder = Nothing
CountFiles = amount
End Function
Sub someStuff()
MsgBox CountFiles("c:/temp/test/")
End Sub
I've turned the sub into a function, which returns the amount of files found in that folder and the subfolders. As before, this works recursively.
A non-recursive option:
Function FilesCount(fldr As String)
Dim colFolders As New Collection, fso, num As Long, f As Object, sf As Object
Set fso = CreateObject("Scripting.FileSystemObject")
colFolders.Add fso.getfolder(fldr) 'add the starting folder
num = 0
Do While colFolders.Count > 0 'while we still have folders to process...
Set f = colFolders(1) ' get the first folder from the collection
colFolders.Remove 1 ' and remove it from the collection
num = num + f.Files.Count ' Add # of files in that folder
For Each sf In f.subfolders ' and add each subfolder into the collection
colFolders.Add sf
Next sf
Loop
FilesCount = num
End Function
I have a listbox that displays XLSM files from a folder Archive and PDFs from a folder called PDF in the folder of the main XLSM file, Main.
C:\Main\Archive\, C:\Main\PDF\, the XLSM looking up these items is located in the root folder C:\Main\
I would like to display the most recent modified files in descending order.
So if a file was created today, it would show on top followed by the one created yesterday and so on.
The code I have is just the standard AddItem to ListBox1
MyFile = Dir(MyFolder & "\*.xlsm")
Do While MyFile <> ""
ListBox1.AddItem MyFile
MyFile = Dir
Loop
These files also have names that start with either FSO or PPG followed by the "ticket number" like 1031, company name, job type and simple date.
FSO 10333 Co Name Job Type 042220.xlsm
PPG 10332 Co Name Job Type 042120.xlsm
That's how the names are displayed in the listbox. PDFs are the same name.
Thank you for your time!
What about the following:
Use of FileSystemObject to access file properties like: GetExtensionName, DateCreated and Name.
Use of Dictionary object to create a library and store values in memory.
Use of ArrayList object to create a list to store creation timedate values which we then can Sort ascending and Reverse to create an descending list.
We can then iterate ArrayList to return values from our Dictionary and add them to the ListBox in order.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim arrList As Object: Set arrList = CreateObject("System.Collections.ArrayList")
Dim FSO: Set FSO = CreateObject("scripting.FileSystemObject")
Dim oFolder, oFile
Set oFolder = FSO.getfolder(MyFolder)
For Each oFile In oFolder.Files
If FSO.GetExtensionName(oFile) = "xlsm" Then
dict(oFile.DateCreated) = oFile.Name
arrList.Add oFile.DateCreated
End If
Next
arrList.Sort
arrList.Reverse
For i = 0 To arrList.Count - 1
ListBox1.AddItem dict(arrList(i))
Next
In support of my comment, omething like this will help you get the date from the file name. You can then use Excel to sort on this.
Sub testing()
Debug.Print get_date("FSO 10333 Co Name Job Type 042220.xlsm")
End Sub
Function get_date(strInput As String) As Date
Dim lngLength As Long
Dim lngLastSpace As Long
Dim strEndSection As String
lngLength = Len(strInput)
lngLastSpace = InStrRev(strInput, " ")
strEndSection = Mid(strInput, lngLastSpace)
strEndSection = Trim(Split(strEndSection, ".")(0)) ' The date bit
get_date = DateSerial(Mid(strEndSection, 5, 2), _
Mid(strEndSection, 1, 2), _
Mid(strEndSection, 3, 2))
End Function
I have two versions of code that i have tried that are slightly different and neither works unfortunately. I need some help figuring out why and how to do what i need to do thanks
The first bit of code somehow immediately ends the loop and doesn't meet the initial conditional expression though I am not sure why because it should call all .docx files in that folder
the second bit of code throws an error Invalid Use of Property with this line Set wApp.Visible = True and I do not know why
First version
Dim folder As String
Dim doc As Document
folder = "G:\GAV\Educational On Assignment Folder\On Assignment Tour Reports\2019\On Tour Questionnaire"
file = Dir(folder & "*.dox*")
r = 1
Do While Len(file) < 0
Set doc = Documents.Open(Filename:=folder & file)
ActiveDocument.Selection.WholeStory
Selection.Copy
Workbooks("Reports Excel").Activate
Cells(1, r).Paste
doc.Close
r = r + 1
file = Dire
Loop
Second version
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim mySource As Object
Set obj = CreateObject("Scripting.FileSystemObject")
Set mySource = obj.getfolder("G:\GAV\Educational On Assignment Folder\On Assignment Tour Reports\2019\On Tour Questionnaire")
For Each file In mySource.Files(Word.Application)
If Len(file.Name) > 0 And InStr(1, file.Name, "$") = 0 Then
Set wApp.Visible = True
Set wDoc = wApp.Documents.Open(muSource & "\" & file.Name, , ReadOnly)
ActiveDocument.Selection.WholeStory
Selection.Copy
Workbooks("Reports Excel").Activate
Cells(1, r).Paste
doc.Close
r = r + 1
wApp.Quit
Set wApp = Nothing
End If
Next file
I need Excel to open each file in the folder, copy its entire contents and paste to a column in Excel. should be simple
I have a file path (which is a connection path for the worksheet) in the following format:
C:\ExcelFiles\Data\20140522\File1_20140522.csv
I want to extract 20140522.
I tried using responses of How to extract groups of numbers from a string in vba, but they don't seem to work in my case.
please find below
Filename = "C:\ExcelFiles\Data\20140522\File1_20140522.csv"
a = Replace(Mid(Filename, InStrRev(Filename, "_") + 1, Len(Filename)), ".csv", "")
Try the following. Folder is selected.
Sub Folder_S()
Dim sFolder As FileDialog
On Error Resume Next
Set sFolder = Application.FileDialog(msoFileDialogFolderPicker)
If sFolder.Show = -1 Then
Folder_Select sFolder.SelectedItems(1), True
End If
End Sub
Sub Folder_Select(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim strFile As String
Dim FileName As Variant
Dim pathParts() As String
Dim pathPart As String
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
pathParts = Split(SourceFolder.Path, Application.PathSeparator)
pathPart = SourceFolder.Path
For i = 0 To UBound(pathParts)
If pathParts(i) = "20140522" Then
pathPart = pathParts(i - 0)
Exit For
End If
Next i
Row = ActiveCell.Row
With CreateObject("Scripting.Dictionary")
For Each FileItem In SourceFolder.Files
strFile = FileItem.Name
.Item(strFile) = Array(FileItem.Name)
Next FileItem
If .Count > 0 Then
For Each FileName In .Items
Cells(Row, 2).Formula = pathPart
Next FileName
End If
End With
End Sub
I found your question by searching a solution how to get a folder path from a file that is inside this folder path. But your question doesn't match exactly what I need. For those who by your question title will find it for the same purpose as I found, below is my function:
Function getFolderPathFromFilePath(filePath As String) As String
Dim lastPathSeparatorPosition As Long
lastPathSeparatorPosition = InStrRev(filePath, Application.PathSeparator)
getFolderPathFromFilePath = Left(filePath, lastPathSeparatorPosition - 1)
End Function
In some solutions for this purpose, I used FSO, but it takes resources, and I think it isn't worthy to create FSO object if you need it only for this simple function.
the accepted answer is not accurate to read the folder name. here is more dynamic code.
use splitter which splits string based on delimeter and makes an array. now read the second last element in array, thats the folder name.
Dim fileName As String
fileName = "C:\ExcelFiles\Data\20140522\File1_20140522.csv"
Dim vPathSplitter As Variant
vPathSplitter = Split(fileName, "\")
MsgBox (vPathSplitter(UBound(vPathSplitter) - 1))
The below answer gets your file path from a range, rather than a fixed string. Much more handy if your planning on getting your filename from your sheets, which I imagine you are.
Sub GetFileDate()
Dim filename As String
filename = Sheets("Sheet1").Range("C9").Value 'Or Wherever your file path is
MsgBox Replace(Right(filename, 12), ".csv", "")
End Sub
This assumes the numbers your extracting will ALWAYS be dates in YYYYMMDD format and the file type is always .csv
I'm trying to get the first file of a directory. I don't care that "first" is not well defined in this case, and I don't care if I'll get a different file each time I call my sub.
I try to use:
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
Set FileItem = SourceFolder.Files.Item(0)
but this returns a compiler error ("Invalid procedure call or argument")
Could you please tell me how to make this work?
Thanks,
Li
You may use the bulit in Dir function
Below is the sample code which returns the first file found name from Test folder.
Sub test()
Dim strFile As String
strFile = Dir("D:Test\", vbNormal)
End Sub
It looks to me like SourceFolder.Files will only accept a string as the key, just like you noted with Scripting.Folders. I think Santosh's answer is the way to go, but here's a kludgy modification of your code that returns the "first" file in the folder:
Sub test()
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim FileItemToUse As Object
Dim SourceFolderName As String
Dim i As Long
SourceFolderName = "C:\Users\dglancy\Documents\temp"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
For Each FileItem In SourceFolder.Files
If i = 0 Then
Set FileItemToUse = FileItem
Exit For
End If
Next FileItem
Debug.Print FileItemToUse.Name
End Sub
It’s true that VBA has a limitation (a bug or design flaw in my opinion) in which a file system object's Files collection cannot be accessed by item-index number, only by each item’s file-path string value. The original question posted here is about accessing only the first item in the Files collection but it touches on a general problem for which there are two reasonable workarounds: creation and use of either a File object meta-collection or a File object array to provide indexed access to a Files collection. Here’s a demo routine:
Sub DemoIndexedFileAccess()
'
'Demonstrates use of both a File object meta-collection and a File object array to provide indexed access
'to a Folder object's Files collection.
'
'Note that, in both examples, the File objects being accessed refer to the same File objects as those in
'the Folder object's Files collection. (i.e. if one of the physical files gets renamed after the creation
'of the Folder object's Files collection, all three sets of File objects will refer to the same, renamed
'file.)
'
'IMPORTANT: This technique requires a reference to "Microsoft Scripting Runtime" be set.
'
'**********************************************************************************************************
'File-selector dialog contsants for msoFileDialogFilePicker and msoFileDialogOpen:
Const fsdCancel As Integer = 0 'File dialog Cancel button
Const fsdAction As Integer = -1 'File dialog Action button, and its aliases...
Const fsdOpen As Integer = fsdAction
Const fsdSaveAs As Integer = fsdAction
Const fsdOK As Integer = fsdAction
Dim FD As FileDialog
Dim File As Scripting.File
Dim FileArr() As Scripting.File
Dim FileColl As New Collection
Dim Folder As Scripting.Folder
Dim FSO As Scripting.FileSystemObject
Dim Idx As Integer
'Get a folder specification from which files are to be processed
Set FD = Application.FileDialog(msoFileDialogFolderPicker) 'Create the FolderPicker dialog object
With FD
.Title = "Select Folder Of Files To Be Processed"
.InitialFileName = CurDir
If .Show <> fsdOK Then Exit Sub
End With
'Use the folder specification to create a Folder object.
Set FSO = New Scripting.FileSystemObject
Set Folder = FSO.GetFolder(FD.SelectedItems(1))
'A Folder object's Files collection can't be accessed by item-index number (only by each item's file-path
'string value), so either...
'1. Create a generic "meta-collection" that replicates the Files collection's File objects, which allows
' access by collection-item index:
For Each File In Folder.Files
FileColl.Add File
Next File
'"Process" the files in (collection) index order
For Idx = 1 To FileColl.Count
Debug.Print "Meta-Collection: " & FileColl(Idx).Name
Next Idx
'2. Or, create an array of File objects that refer to the Files collection's File objects, which allows
' access by array index:
ReDim FileArr(1 To Folder.Files.Count)
Idx = 1
For Each File In Folder.Files
Set FileArr(Idx) = File
Idx = Idx + 1
Next File
'"Process" the files in (array) index order
For Idx = LBound(FileArr) To UBound(FileArr)
Debug.Print "File Object Array: " & FileArr(Idx).Name
Next Idx
End Sub
I solve the problem in this Way:
Private Function GetFirstFile(StrDrive as String) As String
'Var Declarations
Dim Fso As Object, Drive As Object, F As File
'Create a reference to File System Object and Drive
Set Fso = New Scripting.FileSystemObject
Set Drive = Fso.GetDrive(StrDrive)
If Not Drive Is Nothing Then
'Scan files in RootFolder.files property of then drive object
For Each F In Drive.RootFolder.Files
Exit For
Next
'if there are any file, return the first an get then name
If Not F Is Nothing Then FirstFile = F.Name: Set F = Nothing
Set Drive = Nothing
End If
Set Fso = Nothing
End Function
Don´t forget add Reference to Microsoft Scripting Runtime in your project
It works to me... I hope this Help you guys.
Why don't you just use a function to iterate through the files in the folder until you get to the one that you want? Assuming you're using the fso as detailed in other posts above, just pass the Folder, and the Index of the file you want, it could be #1 or any other file in the folder.
Function GetFile(oFolder As Folder, Index As Long) As File
Dim Count As Long
Dim oFile As File
Count = 0
For Each oFile In oFolder.Files
Count = Count + 1
If Count = Index Then
Set GetFile = oFile
Exit Function
End If
Next oFile
End Function