Найти файл, зная префикс файла

Я пытаюсь найти файл, чтобы отправить его в виде приложения к клиенту. Пользователь вводит имя клиента, чтобы получить адрес электронной почты и номер файла в качестве ссылки для поиска правильного файла в листе Excel. Пользователь также вводит путь к файлу в листе Excel.

Проблема в том, что имя файла случайно генерируется из другой системы, и я мог идентифицировать только первые 30 символов из имени файла, содержащего номер файла, в то время как остальные символы генерируются случайным образом.

Код VBA показывает «Путь не найден».

Sub SendEVAT() Dim strLocation As String Dim strName As String Dim fldpath As String Dim fldpath1 As String Dim fso As Scripting.FileSystemObject Dim fsoFile As Scripting.File Dim fsoFldr As Scripting.Folder Dim OutApp As Object Dim OutMail As Object Dim i As Long Dim m As Long, n As Long Dim lastrow As Long Dim mrow1 As Long, nrow1 As Long Dim strbody1 As String, strbody2 As String Dim rng As Range Dim colm As Integer colm = Sheets("Input").Range("N4").Value With Worksheets("Input") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row mrow1 = Sheets("Email Content").Cells(10, 1).End(xlUp).Row For m = 2 To mrow1 strbody1 = strbody1 & "<br>" & Sheets("Email Content").Cells(m, 1) Next m nrow1 = Sheets("Email Content").Cells(15, 2).End(xlUp).Row For n = 2 To nrow1 strbody2 = strbody2 & "<br>" & Sheets("Email Content").Cells(n, 2) Next n For i = 1 To lastrow - 1 Set fso = CreateObject("Scripting.FileSystemObject") fldpath = Sheets("Input").Range("N2") & "\" & Sheets("Input").Cells(i + 1, 6).Value & "*" Set fsoFldr = fso.getfolder(fldpath) If Sheets("Input").Cells(i + 1, 2).Value <> Sheets("Input").Cells(i + 1 - 1, 2) Then Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Set rng = Sheets("Input").Range(Cells(1, 1), Cells(1, colm)) For Each fsoFile In fsoFldr.Files If fso.GetExtensionName(fsoFile) = "pdf" Then fldpath1 = fsoFile.Path End If Next fsoFile If Len(fldpath1) = 0 And Sheets("Input").Cells(i + 1, 2).Value <> Sheets("Input").Cells(i + 1 + 1, 2) Then Sheets("Input").Cells(i + 1, 10).Value = "File Not Found" With OutMail .Display End With ElseIf Len(Dir(fldpath1)) = 0 And Sheets("Input").Cells(i + 1, 2).Value = Sheets("Input").Cells(i + 1 + 1, 2) Then Sheets("Input").Cells(i + 1, 10).Value = "File Not Found" Else Set rng = Union(rng, Range(Cells(i + 1, 1), Cells(i + 1, colm))) With OutMail .To = Sheets("Input").Cells(i + 1, 9).Value .Subject = Sheets("Input").Range("N3").Value & " " & Sheets("Input").Cells(i + 1, 2).Value .HTMLBody = "<p style='font-family:verdana;font-size:13'>" & strbody1 & "<p>" & "<br>" & RangetoHTML(rng) & "<br>" & "<p style='font-family:verdana;font-size:13'>" & strbody2 & "<p>" strLocation = fldpath1 .Attachments.Add (strLocation) If Sheets("Input").Cells(i + 1, 2).Value <> Sheets("Input").Cells(i + 2, 2) Then If Sheets("Input").Range("N1").Value = "Send" Then .Send Else .Display End If End If End With Sheets("Input").Cells(i + 1, 10).Value = "Sent" Sheets("Input").Cells(i + 1, 7).Value = Date Sheets("Input").Cells(i + 1, 8).Value = "E-mail" End If ElseIf Sheets("Input").Cells(i + 1, 2).Value = Sheets("Input").Cells(i + 1 - 1, 2) Then For Each fsoFile In fsoFldr.Files If fso.GetExtensionName(fsoFile) = "pdf" Then fldpath1 = fsoFile.Path End If Next fsoFile If Len(fldpath1) = 0 And Sheets("Input").Cells(i + 1, 2).Value <> Sheets("Input").Cells(i + 1 + 1, 2) Then Sheets("Input").Cells(i + 1, 10).Value = "File Not Found" With OutMail .Display End With ElseIf Len(Dir(fldpath1)) = 0 And Sheets("Input").Cells(i + 1, 2).Value = Sheets("Input").Cells(i + 1 + 1, 2) Then Sheets("Input").Cells(i + 1, 10).Value = "File Not Found" Else Set rng = Union(rng, Range(Cells(i + 1, 1), Cells(i + 1, colm))) With OutMail .To = Sheets("Input").Cells(i + 1, 9).Value .Subject = Sheets("Input").Range("N3").Value & " " & Sheets("Input").Cells(i + 1, 2).Value .HTMLBody = "<p style='font-family:verdana;font-size:13'>" & strbody1 & "<p>" & "<br>" & RangetoHTML(rng) & "<br>" & "<p style='font-family:verdana;font-size:13'>" & strbody2 & "<p>" strLocation = fldpath1 .Attachments.Add (strLocation) If Sheets("Input").Cells(i + 1, 2).Value <> Sheets("Input").Cells(i + 2, 2) Then If Sheets("Input").Range("N1").Value = "Send" Then .Send Else .Display End If End If End With Sheets("Input").Cells(i + 1, 10).Value = "Sent" Sheets("Input").Cells(i + 1, 7).Value = Date Sheets("Input").Cells(i + 1, 8).Value = "E-mail" End If End If Next i On Error GoTo 0 'enter code here'End With Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

Ниже представлен экран листа Excel, который будет использоваться пользователем.

Формат Excel

Как найти файл, который знает только первые 30 символов имени файла?

Давайте будем гением компьютера.