If the company name is in the filename, it is simpler than I anticipated. The following is untested with your data, but it will work if that data is as described. Column D appears to be unused?

Note that the code uses the function from http://www.rondebruin.nl/win/s1/outlook/openclose.htm to open or grab Outlook correctly. You don't want to be creating new Outlook instances for each message, and you need to open it correctly to edit the message body, which method used retains the default signature associated with the account.

The code checks that the folder exists and uses a different method to loop through the data as yours leaves an empty message open.

The code leaves all the messages open unless you re-activate .Send, so test with a smaller data set e.g. make LastRow = 4 



Option Explicit

Sub SendMassEmail()
Dim lastRow As Long
Dim row_number As Long
    With Sheet1
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For row_number = 2 To lastRow
            Call SendEmail(.Range("B" & row_number), _
                           .Range("C" & row_number), _
                           .Range("E" & row_number), _
                           .Range("F" & row_number), _
                           .Range("G" & row_number), _
                           .Range("A" & row_number))
            DoEvents
        Next row_number
    End With
End Sub


Sub SendEmail(what_address As String, _
              carbon_copy As String, _
              subject_line As String, _
              mail_body As String, _
              strPath As String, _
              strCompany As String)


Dim olApp As Object    '- Requires the code from 'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
Dim olMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim strFile As String


    Set olApp = OutlookApp()
    Set olMail = olApp.CreateItem(0)


    With olMail
        .To = what_address
        .CC = carbon_copy
        .Subject = subject_line
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor    'access the message body for editing
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        .Display
        oRng.Text = mail_body
        Do Until Right(strPath, 1) = "\"
            strPath = strPath & "\"
        Loop


        If FolderExists(strPath) = True Then
            strFile = Dir$(strPath & "*.*")
            While strFile <> ""
                If InStr(1, strFile, UCase(strCompany)) > 0 Then
                    .Attachments.Add strPath & strFile
                End If
                DoEvents
                strFile = Dir$()
            Wend
           ' .Send 'after testing
        Else
            MsgBox strPath & " does not exist!"
        End If
    End With
    Set olApp = Nothing
    Set olMail = Nothing
End Sub


Private Function FolderExists(strFolderName As String) As Boolean
'Graham Mayor
'strFolderName is the name of folder to check
Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If (FSO.FolderExists(strFolderName)) Then
        FolderExists = True
    Else
        FolderExists = False
    End If
lbl_Exit:
    Set FSO = Nothing
    Exit Function
End Function