I want a list of file names with a specific extension.
I am using this guide: https://trumpexcel.com/list-of-file-names-from-a-folder-in-excel/
The code doesn't return any values.
I entered the formula and it seems to return the value, however, it results in an error. I removed the IfError to test if it is even working. See screenshot:
With the full formula used together with IfError, nothing gets called out, which is not supposed to happen:
Full formula returns nothing
Function GetFileNamesbyExt(ByVal FolderPath As String, FileExt As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
For Each MyFile In MyFiles
If InStr(1, MyFile.Name, FileExt) <> 0 Then
Result(i) = MyFile.Name
i = i + 1
End If
Next MyFile
ReDim Preserve Result(1 To i - 1)
GetFileNamesbyExt = Result
End Function
I managed to resolve the issue. Turns out that my Row() portion is wrong.
Because I am putting the formula in Row 47, my formula should have been:
=IFERROR(INDEX(GetFileNamesbyExt($CK$44,$CK$45),ROW()-46),"")
Many thanks all!
Related
I have the following code which is meant to pull each file name in a specific path and place it into an array. For some reason, although the files in the File Explorer are sorted alphabetically, the code is pulling them out of order. My approach is to first store the file names into the array first, then sort the array afterwards. Is there a better way to approach this?
Additionally, for some reason the line with Debug.Print arr1(i) only prints blanks to the immediate window. Please advise.
Dim arr1(1000) As String, item As Variant
Dim x As Long, y As Long, k As Integer
Dim TempTxt1 As String
Dim TempTxt2 As String
Dim FolderPath As String, path As String, count As Integer
Dim size As Integer, i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("X:\test\testfolder")
For Each oFile In oFolder.Files
arr1(i) = Left(oFile.Name, Application.WorksheetFunction.Find(".", oFile.Name) - 1)
i = i + 1
Debug.Print arr1(i)
Next oFile
'Alphabetize Sheet Names in Array List
For x = LBound(arr1) To UBound(arr1)
For y = x To UBound(arr1)
If UCase(arr1(y)) < UCase(arr1(x)) Then
TempTxt1 = arr1(x)
TempTxt2 = arr1(y)
arr1(x) = TempTxt2
arr1(y) = TempTxt1
End If
Next y
Next x
enter code here
So as per my comment; I think you might benefit from using ArrayList and its ability to Sort. Try:
Sub Test()
Dim oFSO As Object, oFolder As Object, arr As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("X:\test\testfolder")
Set arr = CreateObject("System.Collections.ArrayList")
For Each oFile In oFolder.Files
arr.Add oFSO.GetBaseName(oFile)
Next oFile
arr.Sort
End Sub
Since you pull in names one-by-one we might as well do so in the ArrayList. The .Sort method will then sort the list in ascending order.
Public Sub GetSOPFiles()
' Set folder path
Const FolderPath As String = "C:\Users\test\Desktop\SOP Audit Excel Prototype"
Const FileExt As String = "docx"
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Dim dept As Variant
Dim deptCodes() As Variant
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
' Research built-in Result function in VBA
ReDim Result(1 To MyFiles.Count)
Dim vData As Variant
Dim sTemp As Variant
' Use a For loop to loop through the total number of sheets
For i = 1 To 12
' Setup Select to determine dept values
Select Case i
Case 1
deptCodes = Array("PNT", "VLG", "SAW")
Case 2
deptCodes = Array("CRT", "AST", "SHP", "SAW")
Case 3
deptCodes = Array("CRT", "STW", "CHL", "ALG", "ALW", "ALF", "RTE", "AFB", "SAW")
Case 4
deptCodes = Array("SCR", "THR", "WSH", "GLW", "PTR", "SAW")
Case 5
deptCodes = Array("PLB", "SAW")
Case 6
deptCodes = Array("DES")
Case 7
deptCodes = Array("AMS")
Case 8
deptCodes = Array("EST")
Case 9
deptCodes = Array("PCT")
Case 10
deptCodes = Array("PUR", "INV")
Case 11
deptCodes = Array("SAF")
Case 12
deptCodes = Array("GEN")
End Select
' Loop through files in directory
j = 0
For Each MyFile In MyFiles
' Limit files by file extension
If InStr(1, MyFile.Name, FileExt) <> 0 Then
' Explode file name into array and only pull files with defined dept codes
Dim toSplitFileName As Variant
toSplitFileName = Split(MyFile.Name, "-")
For Each dept In deptCodes
If dept = toSplitFileName(3) Then
ReDim Preserve Result(0 To j)
Result(j) = MyFile.Name
j = j + 1
End If
Next dept
End If
Next MyFile
' Send array to worksheet
Range("A1:A20").Value = Application.WorksheetFunction.Transpose(Result)
Next
End Sub
Okay, you were right about the out of range part. I edited my code and posted it.
What I am trying to do here is pull file names, sort them after parsing their file name (using SELECT to define the different values I am looking for), then transfer those filenames as an array over to each relevant sheet in the workbook.
I had a working (somewhat) function and it was really slow so after receiving some advice on here to send the results to an array then use VBA to transfer directly to worksheets; this is what I have so far.
I'm trying to figure out how I could send the data to each sheet now...I have it working in one sheet. Say it loops through and finds all the files for SELECT Case 1, it sends all of those filenames to column A in Sheet 1. Same for Case 2, etc.
At the moment, it's just populating all of the cells in the defined range with one file name over and over again.
Like so...
Thank you to all of Stack Overflow! After 3 book purchases and a few posts on here so far, I feel I'm starting to make some headway into VBA. Still have a lot to learn though.
I need some help listing all the files and a specific folder. I used this tutorial and I cannot get it to work with the VBA.
Once on one drive, will this still work? If I follow the tutorial without VBA, the function doesn't list the file names...
Please help me.
Thanks,
VBA:
Function GetFileNames(ByVal FolderPath As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
For Each MyFile In MyFiles
Result(i) = MyFile.Name
i = i + 1
Next MyFile
GetFileNames = Result
End Function
Cell Function:
=IFERROR(INDEX(GetFileNames($A$1),ROW()-2),"")
A1:
=REPLACE(CELL("filename"),FIND("[",CELL("filename")),LEN(CELL("filename")),"*")
This actually prints out
https://...../Test/*
I had to remove the slash and * for it to work locally. But still not working on one drive
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
Greetings, I'm hoping for help in figuring out how to store each row of a text file read into a VBA program as a string. I want to modify one of the strings and then put them all back together, but do not know how to read through a text file and store each row as a separate variable in an intelligent way. Thanks for any help you can provide!
If you don't want to add references, you could just go with straight vba code.
Take for instance the following file wordlist.txt:
realize
empty
theorize
line
socialize
here
analyze
The following code uses two methods to do as you described (one more common than the other):
Option Explicit
Sub main()
Dim sFileName As String
Dim sMergedLineArray() As String
Dim sTextToFind As String
Dim sReplacementText As String
Dim sOutputFile As String
Const MY_DELIMITER = "|"
sFileName = "C:\deleteme\wordlist.txt"
sMergedLineArray = ReadFileIntoArray(sFileName)
sTextToFind = "ze"
sReplacementText = "se"
'Loop through each value in the array and make a change if you need to
Dim x As Integer
For x = 0 To UBound(sMergedLineArray)
If InStr(1, sMergedLineArray(x), sTextToFind, vbTextCompare) > 0 Then
sMergedLineArray(x) = Replace(sMergedLineArray(x), sTextToFind, sReplacementText, 1, -1, vbTextCompare)
End If
Next x
sOutputFile = "C:\deleteme\UK_Version.txt"
If Not SpitFileOut(sOutputFile, sMergedLineArray) Then
MsgBox "It didn't work :("
End If
'OR...put it all together, make a mass change and split it back out (this seems unlikely, but throwing it in there anyway)
sTextToFind = "se"
sReplacementText = "ze"
Dim sBigString As String
Dim sNewArray As Variant
sBigString = Join(sMergedLineArray, MY_DELIMITER)
sBigString = Replace(sBigString, sTextToFind, sReplacementText, 1, -1, vbTextCompare)
sNewArray = Split(sBigString, MY_DELIMITER, -1, vbTextCompare)
sOutputFile = "C:\deleteme\American_Version.txt"
If Not SpitFileOut(sOutputFile, sNewArray) Then
MsgBox "It didn't work"
End If
MsgBox "Finished!"
End Sub
Function ReadFileIntoArray(sFileName As String) As String()
Dim sText As String
Dim sLocalArray() As String
Dim iFileNum As Integer
Dim iLineCount As Integer
iFileNum = FreeFile
Open sFileName For Input As #iFileNum
Do Until EOF(iFileNum)
Input #iFileNum, sText
ReDim Preserve sLocalArray(iLineCount)
sLocalArray(iLineCount) = sText
iLineCount = iLineCount + 1
Loop
Close #iFileNum
ReadFileIntoArray = sLocalArray
End Function
Function SpitFileOut(sFileName As String, sMyArray As Variant) As Boolean
Dim iFileNum As Integer
Dim iCounter As Integer
SpitFileOut = False
iFileNum = FreeFile
Open sFileName For Output As #iFileNum
For iCounter = 0 To UBound(sMyArray)
Print #iFileNum, sMyArray(iCounter)
Next
Close #iFileNum
SpitFileOut = True
End Function
If you run the main sub, you'll end up with two files:
UK_Version.txt: This is the result of the first method
American_Version.txt: This is the result of the second
There's lesson 1 of VBA, young Padawan; absorb it, learn and change your login name :P
Look into the FileSystemObject (ref: 1, 2, 3)
You have to go to <Tools/References> menu and include the Microsoft Scripting Runtime and create a global variable Global fso as New FileSystemObject. Now anywhere in your code do things like fso.OpenTextFile() which returns a TextStream. Each TextStream has methods loke ReadLine(), ReadAll(), SkipLine(), WriteLine(), etc ...
Here is a quick sample code.
Global fso as New FileSystemObject
Sub TEST()
Dim ts As TextStream
Set ts = fso.OpenTextFile("text_file.txt", ForReading, False)
Dim s As String
s = ts.ReadAll()
End Sub