excel - 根据部分名称查找文件夹

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