I try to read mutiple txt files with Excel VBA and store their file name and content in an array. However I have a hard time with character sets, since the txt file can contain a variety of languages. Is there a charset that supports all languages or how can I solve the below described problem?
Here is the code I have
Function create_Txt_Content_Array(file_count As Integer, path As String, Optional strType As String) As String()
Dim createArray() As String
Dim file As Variant
Dim read_file As Integer
Dim absolut_path As String
Dim i, j As Integer
Dim text_content As String
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
ReDim createArray(file_count - 1, 1)
If Right(path, 1) <> "\" Then path = path & "\"
file = Dir(path & strType)
absolut_path = path & file
j = 0
While (file <> "")
objStream.Open
objStream.LoadFromFile (absolut_path)
text_content = objStream.ReadText()
objStream.Close
createArray(j, 0) = file
createArray(j, 1) = text_content
Debug.Print (text_content)
i = i + 1
j = j + 1
file = Dir
absolut_path = path & file
Wend
Set objStream = Nothing
End Function
The first file contains Portuguese: no problem
The second file contains English: no problem
The third file contains Hindi: not working
There are other languages like Korean, Japanese and others following.
writing it directly to a sheet cell does the trick
Related
What I'd like to achieve is opening a file from the previously-stored variable. The problem is the filename sometimes contains characters like ŰŐ. VBA environment changes them to the closest one UO. So I'm unable to open a workbook included with "special" characters. What I have tried so far:
Sub open_last_modified()
Dim fso As New FileSystemObject
Dim files, folder, lmfile As String
Dim lmdate As Date
' a file previously created on desktop ( like őőőűűű.xlsx)
' with a proper filename, both method works very well
folder = ("C:\Users\szidzse\Desktop\")
files = Dir(folder & "*.*", vbNormal)
Do While files <> ""
On Error Resume Next 'if it contains non
If FileDateTime(folder & files) > lmdate Then
lmdate = FileDateTime(folder & files)
lmfile = files 'the last modified file what i'd like to open even if it has non-ascii characters.
End If
files = Dir
Loop
Set a = Workbooks.Open(folder & lmfile, ReadOnly:=True) 'does nothing when filename is not proper.
fso.CopyFile Source:=folder & lmfile, Destination:=folder & "temp.xlsx" 'file not found (I've tried to copy and rename it to a proper name.)
End Sub
I've also tried StrConv(string, vbFromUnicode or vbUnicode) without success.
Any help will be appreciated.
Please, test the next function. It should replace the non ASCII characters with similar ones:
Function replaceNonASCIICh(x As String) As String
Dim i As Long
For i = 1 To Len(x)
If AscW(Mid(x, i, 1)) <> Asc(Mid(x, i, 1)) Then
x = Replace(x, Mid(x, i, 1), Chr(Asc(Mid(x, i, 1))))
End If
Next i
replaceNonASCIICh = x
End Function
I tested it on the two not ASCII characters we could see/copy, in the next way:
Sub testReplaceNonASCII()
Dim x As String, result As String
x = ChrW(368) & ChrW(79) 'the string containing the characters you show us
result = replaceNonASCIICh(x)
ActiveCell.Offset(1).Value = result 'in Immediate Window non ASCII characters cannot be seen as they are...
End Sub
I do not know what other characters should be involved. Please, test it on your cases and send some feedback.
Now, supposing that Dir returns all files from the folder, even if their name contain non ASCII characters, you should firstly iterate between all of them and change their names, using the above function (and Name function). If it looks complicated, but if Dir returns them, I will show you how to proceed...
If you share such a file (supposing it is not confidential) I can try testing the code I posted, only supposing that it should work...
Edited:
I copied the workbook you sent in a folder named "InvalidCharacters", like subfolder of the one running the code. Then, I (manually) changed its name adding a suffix and copy it again (keeping the non ASCII characters). Please, do the same and test the following code:
Sub changeNonASCIIFileName()
Dim FSOLibrary As Object, fldObj As Object, fsoFile As Object
Dim foldPath As String, fileName As String, newName As String
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
foldPath = ThisWorkbook.path & "\InvalidCharacters\"
Set fldObj = FSOLibrary.GetFolder(foldPath)
For Each fsoFile In fldObj.files
On Error Resume Next 'if no characters to be replaced you cannot rename the file...
fsoFile.Name = replaceNonASCIICh(fsoFile.Name)
On Error GoTo 0
Next
End Sub
It uses the above function. Please, take care to be there!
I would like to receive some feedback after testing it...
#FaneDuru sorry for my late response.
Your code works, for me, it returns uo instead of űő. But gives File not found. when attempting to open. In my special case for opening a file, putting a question mark where the invalid character is doing the trick.
Workbooks.Open("C:\Users\User\invalid??.xlsx") opens successfully the file named: invalidűő.xlsx
Getting that file's last modified date is a bit trickier,if I tried to store as string it runs into error, file not found, so it must be done via FSO and a lot of mess with the strings, and telling the editor that "Hey this is from Middle European code table!!" so in my case:
Chr(254) is ő in the mid-euro table. If your string contains this char in the editor it handles as the following.
Chr(254) is õ in the western table.
Setting the string with the specified Unicode hex code here ChrW$(&H151) is the key. (Accented o letter). While Chr(254) is (o letter with tilde, or without).
Sub lmfile_check2()
Dim files As String
Dim folder As String
Dim lmdate As Date
Dim lmfile As String
files = Empty
For i = 1 To 11
folder = ThisWorkbook.Sheets(1).Cells(i, 2).Value
files = Dir(folder & "*.*", vbNormal)
Do While files <> ""
On Error Resume Next
If FileDateTime(folder & files) = Empty Then GoTo 2
On Error GoTo 2
lmdate_2:
If FileDateTime(folder & files) > lmdate Or lmdate2 > lmdate Then
If IsEmpty(FileDateTime(folder & files)) Then
GoTo ende
End If
lmfile = files '
If lmdate2 > lmdate And lmdate <> Empty Then
lmdate = lmdate2
Else
lmdate = FileDateTime(folder & files)
End If
End If
GoTo ende
2:
If InStr(1, files, "hétfo") > 0 Then 'this section is for known invalid character
Set fs = CreateObject("Scripting.FileSystemObject")
files2 = Replace(files, "hetfo", "hetf" & ChrW$(&H151), 1, -1, vbTextCompare)
l = Len(files2)
files2 = Left(files2, l - 5)
Set f = fs.GetFile(folder & files2 & ChrW$(&H151) & ".xls")
lmdate2 = f.DateLastModified
If lmdate2 > lmdate Then
lmdate = lmdate2
lmfile = Replace(files, "hetfo", "hetf" & "?", 1, -1, vbTextCompare)
GoTo vege
End If
End If
GoTo lmdate_2
ende:
files = Dir
Loop
ThisWorkbook.Sheets(1).Cells(i, 1) = folder & lmfile
ThisWorkbook.Sheets(1).Cells(i, 4) = lmdate
Set f = Nothing
lmdate = Empty
lmfile = Empty
Next i
For i = 1 To 11
ThisWorkbook.Sheets(1).Cells(i, 1) = Replace(ThisWorkbook.Sheets(1).Cells(i, 1), "hétfo", "hétf" & "?", 1, -1, vbTextCompare)
Next i
MsgBox "Vertig"
End Sub
I have a problem with a VBA code. The macro below is suppose to go to the destination folder which contains only Excel file but with different extension (xls, xlsx, xlsm) and loop over the exising files to find the larges number within the names of the files (the exaples of current files are DelKra 2021-()-162.xls; DelKra 2021-()-163.xls; DelKra 2021-()-164.xlsm).
The macro run smoothly only when the destination folder contains xls Excel files but crashes whenever another type of Excel file is saved in the folder. The command the macro crashes at is:
"CurrentNum = Mid(FileName, Len(FileName) - 6, 3)".
Please help me to fix my macro.*
Sub ConfirmAndSaveDel()
DestinationFolder = "\\oscwawfs01.kingfisherasia.com.hk\common\FINANCE\Public\BUSINESS
TRIPS\Business Trip Delegacje\2021\Domestic\"
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
Dim LastNum As Integer
Dim CurrentNum As Integer
Dim Numerek As String
Dim whereTrip As String
Dim purposeTrip As String
Dim whoTrip As String
Dim startTrip As Date
Dim endTrip As Date
Dim LastRow As Integer
LastNum = 0
FileCount = 0
FileName = Dir(DestinationFolder)
'Loop searching all files
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
'Take from the file name numbers 6,5 i 4 counting from the right
CurrentNum = Mid(FileName, Len(FileName) - 6, 3)
'If it is larger than the current one remember it
If CurrentNum > LastNum Then
LastNum = CurrentNum
End If
'Debug.Print FileName
FileName = Dir()
Loop
'Add 1 to the largest number found
LastNum = LastNum + 1
'Debug.Print LastNum
'Change the numer to string and add as many zeros at the beginning of the number to have it as the three digit number
If Len(Trim(CStr(LastNum))) = 1 Then
Numerek = "00" & CStr(LastNum)
ElseIf Len(Trim(CStr(LastNum))) = 2 Then
Numerek = "0" & CStr(LastNum)
ElseIf Len(Trim(CStr(LastNum))) = 3 Then
Numerek = CStr(LastNum)
End If
'Combine the whole name of the new file
NazwaPliku = "DelKra 2021-" & "(" & Range("FRIFAR").Value & ")-" & Numerek
Try using such a function:
Function extractNumber(strName As String) As Long
Dim arr: arr = Split(strName, "-")
extractNumber = Split(arr(Ubound(arr)), ".")(0)
End Function
Copy the above function in the same module and call it as:
CurrentNum = extractNumber(fileName)
I mean, replace CurrentNum = Mid(FileName, Len(FileName) - 6, 3) with the above way. It is independent of extension number of characters.
And besides that, please replace all declarations As Integer with As Long. In VBA that way of declaring does not bring any benefit in terms of memory handling or from any other point of view... It is good to cultivate such a habit in all cases. But if you like your way, please adapt the function to return As Integer...
The following function will extract the part of the filename between the last dash and the last dot of the filename. If it is numeric, it will return that number, else (or if the filename doesn't follow the pattern) 0.
Function getFileNumber(filename As String) As Long
Dim pDash As Long, pDot As Long
pDash = InStrRev(filename, "-")
pDot = InStrRev(filename, ".")
If pDash = 0 Or pDot = 0 Or pDot < pDash Then Exit Function
Dim suffix As String
suffix = Mid(filename, pDash + 1, pDot - pDash- 1)
If IsNumeric(suffix) Then
getFileNumber = Val(suffix)
End If
End Function
I have a VBA code that quickly transfer data from CSV files, but unfortunately exclude leading zeros (For example 000123 is converted to 123)
Filename = "c:\text.csv"
Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet
Set wbI = ThisWorkbook
Set wsI = wbI.Sheets("Temp")
Filename = "c:\text.csv"
Set wbO = Workbooks.Open(Filename)
wbO.Sheets(1).Cells.Copy wsI.Cells
wbO.Close SaveChanges:=False
I have tried to add the following after opening the csv file > Cells.NumberFormat = "#"
Set wbO = Workbooks.Open(Filename)
Cells.NumberFormat = "#"
wbO.Sheets(1).Cells.Copy wsI.Cells
wbO.Close SaveChanges:=False
Unfortunately, it is not working and the problem I see is that once the file opens already is missing the leading zeros
Is it possible to open the file without affecting the leading zeros and show all the data as text to maintain the leading zeros?
Try this way, please:
Sub testOpenWithLZeroTxt()
Dim Filename As String, wbI As Workbook, wbO As Workbook, wsI As Worksheet
Dim arrTXT, nrCol As Long, arr(), i As Long, sep As String, lineSep As String
Dim allTxt As String, txtStr As Object, fileTxt As String, fs As Object, f As Object, ts As Object
Set wbI = ThisWorkbook
Set wsI = wbI.Sheets("Temp")
Filename = "c:\text.csv"
fileTxt = Split(Filename, ".")(0) & ".txt" 'create a helper txt file using the csv string content
Set fs = CreateObject("Scripting.FileSystemObject")
allTxt = fs.OpenTextFile(Filename, 1).ReadAll 'reed the csv file content
fs.CreateTextFile fileTxt
Set f = fs.GetFile(fileTxt)
Set ts = f.OpenAsTextStream(2, -2)
ts.write allTxt 'write the csv content in a newly created txt file
ts.Close
'Check the number of text file columns:_______
sep = vbLf ' if not working you can try vbCrLf. It works so on your file
lineSep = "," 'it my be vbTab, ";" etc. It works so on your file
arrTXT = Split(allTxt, sep)
nrCol = UBound(Split(arrTXT(0), lineSep))
'_____________________________________________
ReDim arr(nrCol) 'redim the format array
For i = 0 To nrCol
arr(i) = Array(i + 1, 2) 'fill the format array with variant for TEXT Format!
Next
'open the helper txt file as you need:
Workbooks.OpenText Filename:=fileTxt, origin:=437, startRow:=1, _
DataType:=xlDelimited, Tab:=False, Comma:=True, FieldInfo:=arr()
Set wbO = ActiveWorkbook
'wbO.Sheets(1).cells.Copy wsI.Range("A1") 'copy the content
wbO.Close SaveChanges:=False 'close the file
Kill fileTxt 'kill helper txt file
End Sub
Edited:
I changed the code philosophy. It will firstly read the csv content in a string variable and create a txt file using the obtained string and open it as text, which certainly should work. It will work for any number of columns in the csv file.
The line break in your csv file is unix LF. This corresponds to chr(10).
Since the number of columns in the first row and the number of columns in the next row are inconsistent, a little bias was used. An array was created by doubling the number of columns in the first row.
Sub test()
Dim Ws As Worksheet
Dim Fn As String
Dim Arr As Variant
Fn = "Example.csv"
'Fn = "c:\text.csv"
Set Ws = Sheets("Temp")
Arr = getDatFromCsv(Fn)
With Ws
.Cells.NumberFormat = "#"
.Cells = Empty
.Range("a1").Resize(UBound(Arr, 1) + 1, UBound(Arr, 2) + 1) = Arr
End With
End Sub
Function getDatFromCsv(strFn As String) As Variant
Dim vR() As String
Dim i As Long, r As Long, j As Integer, c As Integer
Dim objStream As Object
Dim strRead As String
Dim vSplit, vRow
Dim s As String
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Charset = "utf-8"
.Open
.LoadFromFile strFn
strRead = .ReadText
.Close
End With
vSplit = Split(strRead, Chr(10)) 'Unix Lf ~~> chr(10)
r = UBound(vSplit)
c = UBound(Split(vSplit(0), ",", , vbTextCompare))
ReDim vR(0 To r, 0 To c * 2)
For i = 0 To r
vRow = Split(vSplit(i), ",", , vbTextCompare)
'If UBound(vRow) = c Then 'if it is empty line, skip it
For j = 0 To UBound(vRow)
vR(i, j) = vRow(j)
Next j
'End If
Next i
getDatFromCsv = vR
Set objStream = Nothing
End Function
Result Image
Use OpenText method instead.
The most important parameter is FieldInfo. You need to pass:
an array containing parse information for individual columns of data. The interpretation depends on the value of DataType. When the data is delimited, this argument is an array of two-element arrays, with each two-element array specifying the conversion options for a particular column. The first element is the column number (1-based), and the second element is one of the XlColumnDataType constants specifying how the column is parsed.
In other words, every column with leading zeros, has to be defined as xlTextFormat.
I'd suggest to record macro. ;) An option to load text data, you'll find under Data tab -> ... -> From text/CSV
I would like to programmatically rename a Windows folder containing one or more illegal Windows characters using VBA. (The folder tree comes from a Mac/Linux environment).
The illegal character shows as a . in Windows/File Explorer, which can manipulate the folder OK.
Methods I have tried unsuccessfully include using the FileSystem Object and the VBA Name command.
Getting the actual name of the folder with the illegal char is the problem.
Doing dir /X shows the short (8.3 format) name of the folder but the full name appears in the command window with ? replacing the illegal char.
Supplying this name with the ? to various routines for folder operations (e.g. FileSystemObject GetFolder, VB Name function, GetShortName) results in the operation not finding the file to operate on.
Running Dir /X > Foldernames.txt produces an ASCII file which shows a ? replacing the illegal char, but examining the file in a binary editor (Frhed) shows 3 bytes for the illegal character in the full folder name. These are Chr(239), Chr(128) and Chr(162). Using this string to replace the illegal char the folder name still results in folder not found behaviour.
Using the actual illegal value (Chr (149))in the folder name also results in folder not found behaviour.
A short file name (8.3 format ) is shown in the Dir /X output and the folder can be accessed via this name. However, I can't see how to distinguish between short names for folders with different illegal chars in the same position, and shortname generation only occurs when the folder exists, so unless I can access the foldername with the illegal char directly it's not much help.
There is a unicode symbol for a placeholder (UxFFFD) which shows as a question mark in a black diamond which I have seen occasionally but not in in any Dir /X listings.
I suggest doing this via a batch-job.
Get the actual name of the file via a list.
You could use a batch like this:
dir "F:\batchs" > "F:\batchs\list.txt"
exit
If you found out the name copy it and replace "'inserthere'" in this code:
ren '_inserthere_' newname.txt
exit
and then run this as a batch job again. This might do the job.
I have found a very laborious way of accessing files and folders with illegal characters in them via their short (8.3) format names. Generating a short name from a path which does not exist is not possible - as the algorithm for generating short names is apparently subject to change and I could not find a reverse-engineer of it.
The only way to get the short name is to do a Dir /X listing for the folder with illegal char or containing a file name with an illegal char and send it to file, which can then be parsed. The long name of the file or folder in the file sometimes includes the illegal character (if it is a ?, which is commonest) so that can be searched for. VBA code for dealing with folders is below. Once the short name of the folder with the illegal char is found it can be easily renamed and returned as a ByRef parameter.
' Procedure : LegalPath
' Author : Simon
' Date : 11/12/2017
' Purpose : returns true if all path chars are legal and changes illegals to _ in sLegalPath if not
Public Function LegalPath(ByVal sPath As String, ByRef sLegalPath As String) As Boolean
Dim iColon As Long
Dim J As Long
Dim sIllegalChars As String
Dim sOutPath As String
On Error GoTo LegalPath_Error
LegalPath = False
sIllegalChars = ""
'If InStr(sPath, "\") <> 0 Then Exit Function
If InStr(sPath, "/") <> 0 Then sIllegalChars = sIllegalChars + "/"
iColon = InStr(sPath, ":") ' allow colon at loc 2
If iColon <> 0 And iColon <> 2 Then sIllegalChars = sIllegalChars + ":"
If InStr(sPath, "*") <> 0 Then sIllegalChars = sIllegalChars + "*"
If InStr(sPath, "?") <> 0 Then sIllegalChars = sIllegalChars + "?"
If InStr(sPath, "<") <> 0 Then sIllegalChars = sIllegalChars + "<"
If InStr(sPath, ">") <> 0 Then sIllegalChars = sIllegalChars + ">"
If InStr(sPath, "|") <> 0 Then sIllegalChars = sIllegalChars + "|"
' check for bullet code (149)
For J = 1 To Len(sPath)
If (asc(Mid(sPath, J, 1)) = 149) Then
sIllegalChars = sIllegalChars & Mid(sPath, J, 1)
End If
Next J
If (sIllegalChars <> "") Then
LegalPath = False
' replace with illegals with underscore
sOutPath = sLegalPath
For J = 1 To Len(sIllegalChars)
sOutPath = Replace(sOutPath, Mid(sIllegalChars, J, 1), "_")
Next J
sLegalPath = sOutPath
Dim sParentFolder As String
sParentFolder = GetFolderFromPath(TruncateR(sPath))
Call shell(GetDAFolder & "\ListDir.bat """ & sParentFolder & """ """ & GetDAFolder & "\ListDir.txt""")
Dim a As TextStream
Dim fs As New Scripting.FileSystemObject
Set a = fs.OpenTextFile(GetDAFolder & "\ListDir.txt", ForReading, False)
Dim sWindowsFolderName As String
Dim sWindowsShortName As String
Dim sLine As String
sWindowsFolderName = GetFileFromPath(TruncateR(sPath))
Do While a.AtEndOfStream <> True
sLine = a.ReadLine
If (Len(sLine) > 50) Then
If (Mid(sLine, 50) = sWindowsFolderName) Then
sWindowsShortName = Mid(sLine, 37, 8)
Name sParentFolder & "\" & sWindowsShortName As sLegalPath
Exit Function
End If
End If
Loop
Else
LegalPath = True
End If
End Function
For files with illegal names, the approach is very similar. Illegal chars are replaced by _. Note that Unicode characters are not flagged as illegal.
Public Function IsIllegalFileCharIN(ByRef sFileName As String, ByVal sFolder As String) As Boolean
Dim sRegex As String
Dim objRegExp As New RegExp
Dim sOut As String
sRegex = "[<>:""/\\|?*„]+"
With objRegExp
.Pattern = sRegex
.IgnoreCase = True
.Global = True
IsIllegalFileCharIN = .test(sFileName)
End With
If (IsIllegalFileCharIN) Then
Dim sLegalFileName As String
With objRegExp
.Pattern = sRegex
.IgnoreCase = True
.Global = True
sLegalFileName = .Replace(sFileName, "_")
End With
' find file short name
Call shell(GetDAFolder & "\ListDir.bat """ & sFolder & """ """ & GetDAFolder & "\ListDir.txt""")
Dim a As TextStream
Dim fs As New Scripting.FileSystemObject
Set a = fs.OpenTextFile(GetDAFolder & "\ListDir.txt", ForReading, False)
Dim sWindowsFolderName As String
Dim sWindowsShortName As String
Dim sLine As String
sWindowsFolderName = sFileName
Do While a.AtEndOfStream <> True
sLine = a.ReadLine
If (Len(sLine) > 50) Then
If (Mid(sLine, 50) = sWindowsFolderName) Then
sWindowsShortName = Mid(sLine, 37, 12)
Name sFolder & "\" & sWindowsShortName As sFolder & "\" & sLegalFileName
sFileName = sLegalFileName
Exit Function
End If
End If
Loop
End If
On Error GoTo 0
End Function
GetDAFolder is a dedicated folder. The batch file ListDir.Bat contains
dir /X %1 >%2
I need to open a file whose full filename I do not know.
I know the file name is something like.
filename*esy
I know definitely that there's only one occurrence of this file in the given directory.
filename*esy is already a "shell ready" wildcard & if thats alway the case you can simply;
const SOME_PATH as string = "c:\rootdir\"
...
Dim file As String
file = Dir$(SOME_PATH & "filename*esy" & ".*")
If (Len(file) > 0) Then
MsgBox "found " & file
End If
Just call (or loop until empty) file = Dir$() to get the next match.
There is an Application.FileSearch you can use (see below). You could use that to search for the files that match your pattern. This information taken from here.
Sub App_FileSearch_Example()
With Application.FileSearch
.NewSearch
.LookIn = "c:\some_folder\"
.FileName = "filename*esy"
If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderDescending) > 0 Then
For i1 = 1 To .FoundFiles.Count
' do something with matched file(s)
Next i1
End If
End With
End Sub
If InStr(sFilename, "filename") > 0 and InStr(sFilename, "esy") > 0 Then
'do somthing
end if
Or you can use RegEx
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "filename(.*)esy"
End With
Set REMatches = RE.Execute(sFilename)
REMatches(0) 'find match
I was trying this question as a function. This is the solution that ended up working for me.
Function fileName(path As String, sName As String, ext As String) As Variant
'path is Full path from root. Can also use path = ActiveWorkbook.path & "\"
'sName is the string to search. ? and * are wildcards. ? is for single char
'example sName = "book?" or sName ="March_*_2014*"
'ext is file extention ie .pdf .xlsm .xls? .j*
Dim file As Variant 'Store the next result of Dir
Dim fname() As String 'Dynamic Array for result set
ReDim fname(0 To 0)
Dim i As Integer ' Counter
i = 0
' Use dir to search and store first result
fname(i) = path & Dir(path & "\" & sName & ext)
i = i + 1
'Load next result
file = Dir
While file <> "" 'While a file is found store that file in the array
ReDim Preserve fname(0 To i) As String
fname(i) = path & file
file = Dir
Wend
fileName = Application.Transpose(fname) 'Print out array
End Function
This works for me as a single or array function.
If you know that no other file contains "filename" and "esy" in that order then you can simply use
Workbooks.Open Filename:= "Filepath\filename*esy.*"
Or if you know the number of missing characters then (assuming 4 characters unknown)
Workbooks.Open Filename:= "Filepath\filename????esy.*"
I use this method to run code on files which are date & timestamped to ignore the timestamp part.