VBA using wildcard to attach word docx

Question

I'm trying to come up with a code to attach a file based on the email requirements. The file name structure is consistant - Date(YY-MM-DD) followed by a unique number which begins with E and a varying description. Example: "17-08-10 E****** file description.docx". The file being attached will have the unique identifier mentioned in the email body.

I've pieced together codes that i found in my search but i still can't figure out it doesn't attach my document.

Here is my code:

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim EmailBody As String

Dim Mail_worksheet As Worksheet
Dim Mail_worksheet1 As Worksheet
Set Mail_worksheet = ThisWorkbook.Sheets("Email")
Set Mail_worksheet1 = ThisWorkbook.Sheets("Send")

Dim strPath As String
Dim strFilter As String
Dim strFile As String
Dim strName As String

Dim c As Integer
Dim d As String

d = ThisWorkbook.Worksheets("Sheet1").Cells(1, 4)

EmailBody = "<body style=""font-family:Calibri;font-size:16"">Hi," & "<br><br>" & _
            "Document attached for:" & "<br><br>"
                On Error Resume Next
                    For c = 0 To d - 1
                    If Mail_worksheet.Cells(15, 2 + c) = Mail_worksheet1.Cells(7, 6) And Mail_worksheet.Cells(4, 2 + c) Like "E*" Then
                    EmailBody = EmailBody & Mail_worksheet.Cells(4, 2 + c) & "<br>"

                        strPath = "D:\My Documents\"      'Edit to your full path
                        strName = Mail_worksheet.Cells(4, 2 + c) 
                        strFilter = "*.docx"
                        strFile = Dir(strPath & Format(Date, "YY-MM-DD") & strName & strFilter)

                        While (strFile <> "")
                        If InStr(strFile, "") > 0 Then 'i think my problem is in this line, i'm not sure what to make of it.
                        newItem.Attachments.Add (strPath & strFile)
                        End If
                        strFile = Dir
                        Wend

                    End If
                    Next c

            EmailBody = EmailBody & "<br>Thank you." & "<br><br>" & _
                        "Best regards," 

On Error Resume Next
With OutMail
    .To = ""
    .CC = ""
    .Subject = "Word doc for product - " & Format(Date, "DD MMM YYYY")
    .HTMLBody = EmailBody

    .Display

End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

Answer 1

Anyway, managed to figure this out. Had to create new integers for this part to work.

For a = 0 To b - 1
    If Mail_worksheet.Cells(15, 2 + a) = Mail_worksheet1.Cells(7, 6) And Mail_worksheet.Cells(4, 2 + a) Like "E*" Then
        strPath = "D:\My Documents\"
        strName = "*" & Mail_worksheet.Cells(4, 2 + a).Value & "*.docx"
        strFile = Dir(strPath & strName)

        Do While Len(strFile) > 0

        OutMail.Attachments.Add strPath & strFile
        strFile = Dir
        Loop
    End If

    Next a

Thanks niton for your guidance!

VBA using wildcard to attach word docx

Question

1 answers

solution1
0 2017-08-16 10:10:32

VBA using wildcard to attach word docx

Question

1 answers

solution1 0 2017-08-16 10:10:32

solution1
0 2017-08-16 10:10:32