我正在尝试查找文件，作为附件发送给客户。用户输入客户名称以获取电子邮件地址和文件编号作为参考，以在Excel工作表中查找正确的文件。用户还在Excel工作表中输入文件路径。
问题是文件名是从不同的系统中随机生成的，我只能识别文件名中包含文件编号的前30个字符，而其余字符是随机生成的。
VBA代码显示＆＃34;未找到路径＆＃34;。
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工作表的显示
如何只知道文件名的前30个字符来搜索文件？
