Excel macro that searches folder for partial filename to attach to email

[tachiro]

Background: So a coworker wrote up some code for me that allows me quickly send out quote approvals back to our repair vendors. I work at an Airline.

With this macro now, I type the order number in one column, the vendor name in another, hit the send button, and it will open up an email in outlook with with the vendor's email and just about everything else already filled out. Then i go search for the .pdf(s) i need to attach and then it's ready to send. It's not quite perfect yet, but i'm making little changes here and there to the code. Ultimately i'm trying to use this as an opportunity to learn about macros/vba in general. Well to get started learning anyway.

But for now, I am curious as to whether or not it is possible to get this macro to search a folder for the order number i entered, find it, and attach it to the email. The problem i'm having is that it the order number is only a part (the beginning) of the file name it's searching for. Here's the code:

 Sub mailRepVendor()

Application.Calculation = xlCalculationAutomatic

    Dim ordCount As Integer
    ordCount = Range("A2", Range("A100").End(xlUp)).Rows.Count 'count the # of orders in your range

    If ordCount > 1 Then 'if there are more than one orders
        multipleOrders   'then call the multiple order function
        
    Else: singleOrder 'if there is not more than one order, then call the single order function
        
    End If
    
End Sub



Function singleOrder()
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
    Dim wks As Worksheet
    Set wks = Sheets("Form")

    ordNum = wks.Range("A2").Value
    vName = wks.Range("C2").Value
    vAddr = wks.Range("D2").Value
    
        On Error GoTo break
        
        Set outObj = OutApp.CreateItem(0)
        On Error Resume Next
        With outObj
            .To = vAddr
            .Cc = "*HDQ Repairs Group"
            .Subject = "RO: " & ordNum & " Quote Approval"
            .Attachments.Add ("C:\Documents and Settings\Tachiro\Desktop\orders\" & ordNum & ".pdf")
            .Body = _
                "Hi " & vName _
                & vbNewLine & vbNewLine _
                & "Please see the attached quote approval and provide an ESD. Thank you." _
                & vbNewLine & vbNewLine _
                & "Sincerely," _
                & vbNewLine _
                & "My first and last name" _
                & vbNewLine _
                & "Airline| Repairs Department | my number"
            .Display
            
        End With
break:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Function




Function multipleOrders()

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
    Dim wks As Worksheet
    Set wks = Sheets("Form")
    
    ordNum = wks.Range("$A$2").Value
    vName = wks.Range("C2").Value 'the vendor name is static, so we can leave it
    vAddr = wks.Range("D2").Value '... so is the vendor the vendor address
        
    Dim i As Integer
    i = Range("A2", Range("A100").End(xlUp)).Rows.Count 'get number of orders in col A
        
    Dim vArr() As String 'declare an array to build our string of repair orders
    ReDim vArr(1 To i)   'set new dimensions so the array has "i" elements
    
    For x = 1 To UBound(vArr) 'loop from 1 to the max element of the array
        vArr(x) = Cells(x + 1, 1).Value 'as we loop, increment both the array element and cell range
    Next x
    
    'now build the array into a string so that we can put it into the email body
    Dim repairList As String
    For x = 1 To UBound(vArr) - 1
        repairList = repairList + vArr(x) + ", "
    Next x
    
    repairList = repairList + vArr(UBound(vArr)) 'the reason we did this outside of the loop is so
                                                 'that the last order in the repair element string
                                                 'did not have a comma at the end.
        
        'now that we have the R/O string built, we can take the same outlook object/method
        'as before and use the new variables we created to build the body...
        
        On Error GoTo break
                Set outObj = OutApp.CreateItem(0)
                On Error Resume Next
                With outObj
                    .To = vAddr
                    .Cc = "*HDQ Repairs Group"
                    .Subject = "RO: " & ordNum & " Quote Approvals"
                    .Body = _
                        "Hi " & vName _
                        & vbNewLine & vbNewLine _
                        & "Please see the attached quote approvals and provide ESDs. Thank you." _
                        & vbNewLine & vbNewLine _
                        & "Sincerely," _
                        & vbNewLine _
                        & "My first and last name" _
                        & vbNewLine _
                        & "Airline| Repairs Department | my number
                    .Display
                End With
                
break:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Function

What i have there now is just me fiddling with the attachments.add thing. i got it to find and attach a file but of course that was when the order number and filename were an exact match. If there are anymore details needed in order to help me, i'll try to asap. Thank you.

 

[tlowry]

Here is some code you might find useful.

Function findfiles returns an array of pdf filenames that start with sFile that are in folder sPath. If no files match the criteria, then the array is Empty.

sub test is just that

Option Explicit
Function findfiles(sPath, sFile As String) As Variant
    Dim fn, i
    fn = Dir(sPath & sFile & "*.pdf")
    If fn = "" Then Exit Function
    i = 0
    ReDim aFn(i)
    aFn(i) = fn
    Do While fn <> ""
        fn = Dir
        i = i + 1
        ReDim Preserve aFn(i)
        aFn(i) = fn
    Loop
    ReDim Preserve aFn(i - 1)
    findfiles = aFn
End Function
Sub test()
    Dim filenames, fn
    filenames = findfiles("C:\Temp\", "Tax")
    If Not IsEmpty(filenames) Then
        For Each fn In filenames
            Debug.Print "C:\Temp\" & fn
        Next fn
    End If
End Sub