根据部分名称查找文件夹

Question

考虑到用户插入的参数，我有工作表来生成电子邮件（在 Outlook 上）。

我正在编写代码并在电子邮件正文中包含表格。

我需要包含 PDF 附件。

文件位于名称始终为的目录中：
- 一个数字（在纸上）
- 一个随机字符串

示例：某人要求 340 号的电子邮件，
我需要找到文件夹 340-srts。

只有一个文件夹，以“340”开头

有没有办法搜索一个文件夹，并获取其中的文件，只有它的一部分名称？

Dim OutMail As Object

Set OutMail = OutApp.CreateItem(0)

rma_number = Worksheets("HEADER").Range("C5").Value2


With OutMail
.To = To_Mail
.CC = ""
.BCC = ""
.Subject = "some text"
.HTMLBody = "more text"
.attachments.Add Dir("\\Pmbrsor-fs01\Compartilhado\CSR\Arquivos de Chamados\Chamados Internos\" + Cstr(rma_number)*)
.Display
End With


'also tried

Get_Laudo = Dir("\\Pmbrsor-fs01\Compartilhado\CSR\Arquivos de Chamados\Chamados Internos\" + Cstr(rma_number)*)

Answer 1

您不能在路径中直接使用通配符添加文件：您首先需要使用 Dir() 查看文件是否存在，然后使用实际文件名添加附件。

对于单个文件，它看起来像这样：

Const FLDR_PATH As String = "\\Pmbrsor-fs01\Compartilhado\CSR\Arquivos de Chamados\Chamados Internos\"

Dim fName

fName = Dir(FLDR_PATH  & Cstr(rma_number) & "*")

If fName  <> "" Then 
    .attachments.Add FLDR_PATH & fName
Else
    MsgBox "Attachment file not found!"
End If

编辑：更仔细地阅读您的问题并意识到您正在使用通配符查找文件夹，然后想要该文件夹中的所有文件。

Sub Tester()

    Dim attach As Collection, f

    Set attach = MatchingFiles(rma_number)
    If attach.Count > 0 Then
        For Each f In attach
            .attachments.Add f
        Next f
    Else
        MsgBox "No matching attachments found!"
    End If

End Sub

'return all file in folder matching the provided rma number
Function MatchingFiles(rma_number)
    Const FLDR_PATH As String = "\\Pmbrsor-fs01\Compartilhado\CSR\Arquivos de Chamados\Chamados Internos\"
    Dim rv As New Collection
    Dim fldr, fName

    'First see if we can find the folder
    fldr = Dir(FLDR_PATH & CStr(rma_number) & "-*", vbDirectory)
    If Len(fldr) > 0 Then
        'Found the folder, so collect all of the contained files
        fName = Dir(FLDR_PATH & fldr & "\*", vbNormal)
        Do While Len(fName) > 0
            rv.Add FLDR_PATH & fldr & "\" & fName '<< add the full path for this file
            fName = Dir() '<< next file
        Loop
    End If
    Set MatchingFiles = rv
End Function