I've a bunch of folders with one .accdb DB in each folder. I want to export a number of tables from them to delimited text. The tables are specified in the array arr.
Sub ExtractDBs(tableList as String)
Dim objAccess As Access.Application
Dim db As DAO.Database
Dim fp As String
Dim fso As Object
Dim fsoFolder As Object, fsoSubFolder As Object, fsoFolders As Object
Dim fsoFiles As Object, fsoFile As Object
Dim x As Integer
Dim txtStream As Object
Dim arr() as string
Set objAccess = New Access.Application
arr = Split(tableList, ";")
fp = "\\SomeFilePath"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoFolder = fso.GetFolder(fp)
Set fsoFolders = fsoFolder.SubFolders
For Each fsoSubFolder In fsoFolders
Set fsoFiles = fsoSubFolder.Files
For Each fsoFile In fsoFiles
Set db = objAccess.DBEngine.OpenDatabase(fsoFile.Path, False, True, ";PWD=SomePassword")
For x = 0 To UBound(arr) - 1
objAccess.DoCmd.TransferText acImportDelim, TableName:=arr(x), _
Filename:=fp & "\" & Replace(fsoFile.Name, ".accdb", "") & "\" & arr(x) & ".txt", _
HasFieldNames:=True
Next x
db.Close
Next fsoFile
Next fsoSubFolder
objAccess.Quit
Set objAccess = Nothing
End Sub
The line beginning objAccess.DoCmd.TransferText yields the error
The command or action 'TransferText' isn't available now.
...Which is pretty useless. I can't find an explanation online of what is required to resolve this error.
You haven't actually opened any database.
Application.OpenCurrentDatabase opens a database in the current Access application.
Application.DbEngine.OpenDatabase opens a database using the database engine of the current Access application, but doesn't actually open it in the application.
So, use the following:
objAccess.OpenCurrentDatabase fsoFile.Path, False, "SomePassword"
Related
I need to find from an Access DB if any file in a folder got changed. For this reason I created a table containing the file information (name and DateLastModified). However there is the problem, that Windows always adjusts the DateLastModified to the local time zone and this value will even change on daylight savings (means: DateLastModified will change when DST activates/deactivates)!
To overcome this and to find the files true 'DateLastModified'-date I use FileSystemObject to get 'DateLastModified' and convert the returned value to UTC by means of Function GetUTC. Then I store this value in the database. I carefully tested GetUTC - it will return a value not depending on DST (tested for time zones CET and CEST).
Re-querying the folder and comparing a newly calculated 'DateLastModified' against the stored 'DateLastModified' will fail for approximately 15%-35% of the files - is seems random which files fail! Could it be that DT.GetVarDate(False) in GetUTC does not always return the same binary value?
However using debug.print always shows the same Date & Time for the failing files and the value stored in the database! MS specs says the resolution of datatype 'Date' is one second. So I do not understand how 2 Dates that show the same value will result to false when compared! Sample output of a failed file:
1477 493 18.12.2013 19:03:26 18.12.2013 19:03:26 scanColor0010.pdf
How can I make this work?
Option Compare Database
Option Explicit
Public ws As Workspace
Public db As Database
Function GetUTC(dLocalTimeDate As Date) As Date
Dim DT As Object
Dim curTime As Date
curTime = Now()
Set DT = CreateObject("WbemScripting.SWbemDateTime")
DT.SetVarDate curTime
GetUTC = dLocalTimeDate - curTime + DT.GetVarDate(False)
End Function
'------------------------------------------------------------
' Test_UTC_Click
'
'------------------------------------------------------------
Private Sub Test_UTC_Click()
Dim colFiles As New Collection
Dim vFile As Variant
Dim rst As Recordset
Dim fso As FileSystemObject
Dim f As File
Dim lngCountWrong As Long
Dim lngCount As Long
Set ws = DBEngine.Workspaces(0)
Set db = CurrentDb()
RecursiveDir colFiles, "Y:\", "*.pdf", False
Set fso = CreateObject("Scripting.FileSystemObject")
For Each vFile In colFiles
Set f = fso.GetFile(vFile)
Set rst = db.OpenRecordset("SELECT tblFiles.*, tblFiles.fileName FROM tblFiles WHERE (((tblFiles.fileName)=""" & f.Name & """));")
rst.MoveFirst
lngCount = lngCount + 1
If (rst!fileDateModified = GetUTC(f.DateLastModified)) Then
'Ok, this is always expected
Else
'Uuuups - what went wrong?
lngCountWrong = lngCountWrong + 1
Debug.Print lngCount, lngCountWrong, rst!fileDateModified, GetUTC(f.DateLastModified), f.Name
End If
rst.Close
Set f = Nothing
DoEvents
Next vFile
Debug.Print "finished", lngCount
Set fso = Nothing
End Sub
'------------------------------------------------------------
' CreateTestdata_Click
'
'------------------------------------------------------------
Private Sub CreateTestdata_Click()
Dim colFiles As New Collection
Dim vFile As Variant
Dim rst As Recordset
Dim fso As FileSystemObject
Dim f As File
Set ws = DBEngine.Workspaces(0)
Set db = CurrentDb()
db.Execute "DELETE tblFiles.* FROM tblFiles;"
Set rst = db.OpenRecordset("SELECT tblFiles.* FROM tblFiles;")
RecursiveDir colFiles, "Y:\", "*.pdf", False
Set fso = CreateObject("Scripting.FileSystemObject")
For Each vFile In colFiles
Set f = fso.GetFile(vFile)
rst.AddNew
rst!filename = f.Name
Debug.Print f.Name
rst!fileDateModified = GetUTC(f.DateLastModified)
rst.Update
Set f = Nothing
DoEvents
Next vFile
Set fso = Nothing
rst.Close
Debug.Print "Finished creating"
MsgBox "Finished creating"
End Sub
Rewrite
If (rst!fileDateModified = GetUTC(f.DateLastModified)) Then
'Ok, this is always expected
Else
to
If Datediff("s",rst!fileDateModified,GetUTC(f.DateLastModified)) = 0 Then
'Ok, this is always expected
Else
Further reading on Datediff
Further reading on How to store, calculate, and compare Date/Time data in Microsoft Access. Although this article is on Access it should be similar in Excel
I am trying to upload a dataset from excel to an access database using the following code.
However i keep getting the Run time error 3078- Application defined or object defined error. i am using the dao for this and have added the follwing references:
Microsoft office 16.0 access database engine object library,
Microsoft access 16.0 library.
i am unable to add the Microsoft DAO 3.6 object library (Name conflicts with existing module, project or object libary
here is the code:
Sub access_upload()
Dim strMyPath As String, strDBName As String, strDB As String
Dim i As Long, n As Long, lLastRow As Long, lFieldCount As Long
Dim daoDB As DAO.Database
Dim recSet As DAO.Recordset
strDBName = "Database8.accdb"
'presume to be in the same location as the host workbook:
strMyPath = ThisWorkbook.Path
strDB = strMyPath & "\" & strDBName
Set daoDB = DBEngine.Workspaces(0).OpenDatabase(strDB)
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet2")
Set recSet = daoDB.OpenRecordset("Database8")
lFieldCount = recSet.Fields.Count
lLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lLastRow
recSet.AddNew
For n = 0 To lFieldCount - 1
recSet.Fields(n).Value = ws.Cells(i, n + 1)
Next n
recSet.Update
Next i
recSet.Close
daoDB.Close
Set daoDB = Nothing
Set recSet = Nothing
End Sub
Please let me know what i am missing here. Thanks!
From Excel to Access . . .
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False
' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\Documents\"
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tablename"
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
also if the path and excel name are fixed; you can step thru the import manually using the External features from the ribbon - at the end of which will be a prompt to save those steps as a defined import.
you can then rerun the import just by a docmd to run the saved import
I want to access each subfolder of my current folder(number of subfolders in each sub folder may vary) and then want to perform some operations in each excel workbook of all these subfolders.
Below mentioned is the code and code is not throwing compile time error but not working. Kindly help me
option explicit
Sub LoopFolders()
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant
Dim wbk As Workbook
' Parent folder including trailing backslash
strFolder = "C:\Users\Yashika Vaish\Desktop\yashika\"
' Loop through the subfolders and fill Collection object
strSubFolder = Dir(strFolder & "*", vbDirectory)
Do While Not strSubFolder = ""
Select Case strSubFolder
Case ".", ".."
' Current folder or parent folder - ignore
Case Else
' Add to collection
colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
End Select
' On to the next one
strSubFolder = Dir
Loop
' Loop through the collection
For Each varItem In colSubFolders
' Loop through Excel workbooks in subfolder
strFile = Dir(strFolder & varItem & "\*.xls*")
Do While strFile <> ""
' Open workbook
Set wbk = Workbooks.Open(FileName:=strFolder & _
varItem & "\" & strFile, AddToMRU:=False)
MsgBox "I am open"
strFile = Dir
Loop
Next varItem
End Sub
All the required references in tools settings have already been added in this VBA Project. Kindly help me with this code.
The method below writes the file names from the subfolders too to the workbook. So it finds them.
Sub Program()
Dim i As Integer
i = 1
listFiles "D:\Folder 1", i
End Sub
Sub listFiles(ByVal sPath As String, ByRef i As Integer)
Dim vaArray As Variant
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files
If (oFiles.Count > 0) Then
ReDim vaArray(1 To oFiles.Count)
For Each oFile In oFiles
Cells(i, "A").Value = oFile.Name
Cells(i, "B").Value = oFile.Path
i = i + 1
Next
End If
listFolders sPath, i
End Sub
Sub listFolders(ByVal sPath As String, ByRef i As Integer)
Dim vaArray As Variant
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.subfolders
If (oFiles.Count > 0) Then
ReDim vaArray(1 To oFiles.Count)
For Each oFile In oFiles
listFiles oFile.Path, i
i = i + 1
Next
End If
End Sub
This is what I use & it's a #WorksAtMyBox certified code ;)
Option Explicit
Dim fso As Scripting.FileSystemObject
Dim fsoMainDirectory As Scripting.folder
Dim fsoSubfolder As Scripting.folder
Dim fsoFile As Scripting.file
Dim strFilePath
Dim filecounter As Long
Dim foldercounter As Long
Public Sub FileFinder(fileorfolder As String)
If fso Is Nothing Then
Set fso = New Scripting.FileSystemObject
End If
Set fsoMainDirectory = fso.GetFolder(fileorfolder)
If fsoMainDirectory.SubFolders.Count > 0 Then
For Each fsoSubfolder In fsoMainDirectory.SubFolders
foldercounter = foldercounter + 1
Debug.Print "Folder: " & foldercounter & fsoSubfolder.Path
FileFinder (fsoSubfolder.Path)
Next fsoSubfolder
End If
If fsoMainDirectory.Files.Count > 0 Then
For Each fsoFile In fsoMainDirectory.Files
ProcessFile (fsoFile.Path)
Next fsoFile
End If
End Sub
Public Sub ProcessFile(file As String)
filecounter = filecounter + 1
Debug.Print "File: " & filecounter & ": " & file
End Sub
So, here is how I search through a folder looking for a specific file type. (early binding is your friend at this point in development). Make sure you have the Microsoft Scripting Runtime reference enabled.
Option Explicit
Sub test()
Dim fso As Scripting.FileSystemObject
Dim fsoMainDirectory As Scripting.Folder
Dim fsoSubfolder As Scripting.Folder
Dim fsoFile As Scripting.File
Dim strFilePath
Set fso = New Scripting.FileSystemObject
Set fsoMainDirectory = fso.GetFolder("Directory, with trailing \")
For Each fsoFile In fsoMainDirectory.Files
If fsoFile.Type = "Microsoft Excel 97-2003 Worksheet" Then '.xls file type
strFilePath = fsoFile.Path
Application.Workbooks.Open strFilePath
End If
Next fsoFile
End Sub
How deep do your sub folders go? Are you the only one will use this macro? Looping through n subfolders with an unknown number of subfolders is doable, but my method involves an array of counters. This array can lower performance, and as such don't want to do that if we don't need to.
I've got a code from here and I'm tweaking it for my need. My need is quite simple: I need it to download if it has the name of the Daily Tracker I'm keeping track of (as it changes daily with the Format(Now)). The problem is that it is not finding the attachment.
The code can find the email if I substitute the ElseIf to Next part for oOlItm.Display, but won't download the attachment.
Sub AttachmentDownload()
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\TEMP\TestExcel"
Dim oOlAp As Object
Dim oOlns As Object
Dim oOlInb As Object
Dim oOlItm As Object
Dim oOlAtch As Object
Dim NewFileName As String
NewFileName = "Daily Tracker " & Format(Now, "dd/MM/yyyy")
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
For Each oOlItm In oOlInb.Items
If InStr(oOlItm.Subject, NewFilename)) <> 0 Then
ElseIf oOlItm.Attachments.Count <> 0 Then
For Each oOlAtch In oOlItm.Attachments
oOlAtch.SaveAsFile (AttachmentPath)
Exit For
Next
Else
MsgBox "No attachments found"
End If
Exit For
Next
End Sub
The email:
This should work for you:
Sub AttachmentDownload()
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\TEMP\TestExcel"
Dim oOlAp As Object
Dim oOlns As Object
Dim oOlInb As Object
Dim oOlItm As Object
Dim oOlAtch As Object
Dim oOlResults As Object
Dim x As Long
Dim NewFileName As String
NewFileName = "Daily Tracker " & Format(Now, "dd-MM-yyyy")
'You can only have a single instance of Outlook, so if it's already open
'this will be the same as GetObject, otherwise it will open Outlook.
Set oOlAp = CreateObject("Outlook.Application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'No point searching the whole Inbox - just since yesterday.
Set oOlResults = oOlInb.Items.Restrict("[ReceivedTime]>'" & Format(Date - 1, "DDDDD HH:NN") & "'")
'If you have more than a single attachment they'll all overwrite each other.
'x will update the filename.
x = 1
For Each oOlItm In oOlResults
If oOlItm.attachments.Count > 0 Then
For Each oOlAtch In oOlItm.attachments
If GetExt(oOlAtch.FileName) = "xlsx" Then
oOlAtch.SaveAsFile AttachmentPath & "\" & NewFileName & "-" & x & ".xlsx"
End If
x = x + 1
Next oOlAtch
End If
Next oOlItm
End Sub
'----------------------------------------------------------------------
' GetExt
'
' Returns the extension of a file.
'----------------------------------------------------------------------
Public Function GetExt(FileName As String) As String
Dim mFSO As Object
Set mFSO = CreateObject("Scripting.FileSystemObject")
GetExt = mFSO.GetExtensionName(FileName)
End Function
Another way of doing it is from within Outlook:
Create a new folder in your Outlook Inbox and set a rule to move the email to this folder when it arrives. You can then write code to watch this folder and save the file as soon as it arrives.
Place this code within the ThisOutlookSession module in Outlook.
Dim WithEvents TargetFolderItems As Items
Const FILE_PATH As String = "C:\TEMP\TestExcel\"
Private Sub Application_Startup()
Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.Folders.Item("Mailbox - Darren Bartrup-Cook") _
.Folders.Item("Inbox") _
.Folders.Item("My Email For Processing").Items
End Sub
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
'when a new item is added to our "watched folder" we can process it
Dim olAtt As Attachment
Dim i As Integer
Dim sTmpFileName As String
Dim objFSO As Object
Dim sExt As String
If Item.Attachments.Count > 0 Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
sExt = objFSO.GetExtensionName(olAtt.FileName)
If sExt = "xlsx" Then
sTmpFileName = "Daily Tracker " & Format(Now, "dd-mm-yyyy") & ".xlsx"
End If
Item.UnRead = False
olAtt.SaveAsFile FILE_PATH & sTmpFileName
DoEvents
Next
End If
Set olAtt = Nothing
MsgPopup "A new attachment has been saved.", vbOKOnly, "New Daily Tracker"
End Sub
Private Sub Application_Quit()
Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing
End Sub
Create a new module in Outlook and put this code in there. This will create a messagebox that won't stop whatever you're doing.
Public Function MsgPopup(Optional Prompt As String, _
Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title As String, _
Optional SecondsToWait As Long = 0) As VbMsgBoxResult
' Replicates the VBA MsgBox() function, with an added parameter
' to automatically dismiss the message box after n seconds
' If dismissed automatically, this will return -1: NOT ‘cancel’ or the default button choice.
' Nigel Heffernan, 2006. This code is in the public domain.
' Uses late-binding: bad for performance and stability, useful for code portability
' The correct declaration is: Dim objWshell As IWshRuntimeLibrary.WshShell
Dim objWshell As Object
Set objWshell = CreateObject("WScript.Shell")
MsgPopup = objWshell.Popup(Prompt, SecondsToWait, Title, Buttons)
Set objWshell = Nothing
End Function
This question already has answers here:
Cycle through sub-folders and files in a user-specified root directory [duplicate]
(3 answers)
Closed 1 year ago.
I need to get the names of all the Excel files in a folder and then make changes to each file. I've gotten the "make changes" part sorted out. Is there a way to get a list of the .xlsx files in one folder, say D:\Personal and store it in a String Array.
I then need to iterate through the list of files and run a macro on each of the files which I figured I can do using:
Filepath = "D:\Personal\"
For Each i in FileArray
Workbooks.Open(Filepath+i)
Next
I had a look at this, however, I wasn't able to open the files cause it stored the names in Variant format.
In short, how can I use VBA to get a list of Excel filenames in a specific folder?
Ok well this might work for you, a function that takes a path and returns an array of file names in the folder. You could use an if statement to get just the excel files when looping through the array.
Function listfiles(ByVal sPath As String)
Dim vaArray As Variant
Dim i As Integer
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files
If oFiles.Count = 0 Then Exit Function
ReDim vaArray(1 To oFiles.Count)
i = 1
For Each oFile In oFiles
vaArray(i) = oFile.Name
i = i + 1
Next
listfiles = vaArray
End Function
It would be nice if we could just access the files in the files object by index number but that seems to be broken in VBA for whatever reason (bug?).
You can use the built-in Dir function or the FileSystemObject.
Dir Function: VBA: Dir Function
FileSystemObject: VBA: FileSystemObject - Files Collection
They each have their own strengths and weaknesses.
Dir Function
The Dir Function is a built-in, lightweight method to get a list of files. The benefits for using it are:
Easy to Use
Good performance (it's fast)
Wildcard support
The trick is to understand the difference between calling it with or without a parameter. Here is a very simple example to demonstrate:
Public Sub ListFilesDir(ByVal sPath As String, Optional ByVal sFilter As String)
Dim sFile As String
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
If sFilter = "" Then
sFilter = "*.*"
End If
'call with path "initializes" the dir function and returns the first file name
sFile = Dir(sPath & sFilter)
'call it again until there are no more files
Do Until sFile = ""
Debug.Print sFile
'subsequent calls without param return next file name
sFile = Dir
Loop
End Sub
If you alter any of the files inside the loop, you will get unpredictable results. It is better to read all the names into an array of strings before doing any operations on the files. Here is an example which builds on the previous one. This is a Function that returns a String Array:
Public Function GetFilesDir(ByVal sPath As String, _
Optional ByVal sFilter As String) As String()
'dynamic array for names
Dim aFileNames() As String
ReDim aFileNames(0)
Dim sFile As String
Dim nCounter As Long
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
If sFilter = "" Then
sFilter = "*.*"
End If
'call with path "initializes" the dir function and returns the first file
sFile = Dir(sPath & sFilter)
'call it until there is no filename returned
Do While sFile <> ""
'store the file name in the array
aFileNames(nCounter) = sFile
'subsequent calls without param return next file
sFile = Dir
'make sure your array is large enough for another
nCounter = nCounter + 1
If nCounter > UBound(aFileNames) Then
'preserve the values and grow by reasonable amount for performance
ReDim Preserve aFileNames(UBound(aFileNames) + 255)
End If
Loop
'truncate the array to correct size
If nCounter < UBound(aFileNames) Then
ReDim Preserve aFileNames(0 To nCounter - 1)
End If
'return the array of file names
GetFilesDir = aFileNames()
End Function
File System Object
The File System Object is a library for IO operations which supports an object-model for manipulating files. Pros for this approach:
Intellisense
Robust object-model
You can add a reference to to "Windows Script Host Object Model" (or "Windows Scripting Runtime") and declare your objects like so:
Public Sub ListFilesFSO(ByVal sPath As String)
Dim oFSO As FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Set oFSO = New FileSystemObject
Set oFolder = oFSO.GetFolder(sPath)
For Each oFile In oFolder.Files
Debug.Print oFile.Name
Next 'oFile
Set oFile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
If you don't want intellisense you can do like so without setting a reference:
Public Sub ListFilesFSO(ByVal sPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
For Each oFile In oFolder.Files
Debug.Print oFile.Name
Next 'oFile
Set oFile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Dim iIndex as Integer
Dim ws As Excel.Worksheet
Dim wb As Workbook
Dim strPath As String
Dim strFile As String
strPath = "D:\Personal\"
strFile = Dir(strPath & "*.xlsx")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strPath & strFile)
For iIndex = 1 To wb.Worksheets.count
Set ws = wb.Worksheets(iIndex)
'Do something here.
Next iIndex
strFile = Dir 'This moves the value of strFile to the next file.
Loop
If all you want is the file name without file extension
Dim fileNamesCol As New Collection
Dim MyFile As Variant 'Strings and primitive data types aren't allowed with collection
filePath = "c:\file directory" + "\"
MyFile = Dir$(filePath & "*.xlsx")
Do While MyFile <> ""
fileNamesCol.Add (Replace(MyFile, ".xlsx", ""))
MyFile = Dir$
Loop
To output to excel worksheet
Dim myWs As Worksheet: Set myWs = Sheets("SheetNameToDisplayTo")
Dim ic As Integer: ic = 1
For Each MyFile In fileNamesCol
myWs.Range("A" & ic).Value = fileNamesCol(ic)
ic = ic + 1
Next MyFile
Primarily based on the technique detailed here: https://wordmvp.com/FAQs/MacrosVBA/ReadFilesIntoArray.htm
Regarding the upvoted answer, I liked it except that if the resulting "listfiles" array is used in an array formula {CSE}, the list values come out all in a horizontal row. To make them come out in a vertical column, I simply made the array two dimensional as follows:
ReDim vaArray(1 To oFiles.Count, 0)
i = 1
For Each oFile In oFiles
vaArray(i, 0) = oFile.Name
i = i + 1
Next
Sub test()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder1 = FSO.GetFolder(FromPath).Files
FolderPath_1 = "D:\Arun\Macro Files\UK Marco\External Sales Tool for Au\Example Files\"
Workbooks.Add
Set Movenamelist = ActiveWorkbook
For Each fil In folder1
Movenamelist.Activate
Range("A100000").End(xlUp).Offset(1, 0).Value = fil
ActiveCell.Offset(1, 0).Select
Next
End Sub