CODEWITHSUNDEEP
excelvbafileoutlookdirectory
Laharl Krichevki
Laharl Krichevki

Reputation: 13

Find folders based on partial name

I have worksheets to generate e-mails (on Outlook) considering the parameters inserted by the user.

I have code working to write and including tables to the e-mail's body.

I need to include PDF attachments.

The files are in a directory where the name will always be:
- a number (on the sheet)
- a random string

Example: person asks for e-mail of number 340,
I need to find folder 340-srts.

There will be only one folder, starting with "340"

Is there a way to search for a folder, and get the files inside it, having only a part of it's name?

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)*)

Upvotes: 1

Views: 1586

Answers (1)

Tim Williams
Tim Williams

Reputation: 166126

You can't add a file directly using a wildcard in the path: you first need to see if the file is there using Dir(), then add the attachment with the actual filename.

For a single file it would look like this:

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

EDIT: after reading your question more closely and realizing you were looking for a folder using a wildcard and then wanted all files in that folder.

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

Upvotes: 2

Related Questions