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

根据部分名称查找文件夹

1 个答案: