Add attachment into email Macro

I have written a macro that will send a fixed message to contacts based on the date that is in a cell beside their name. What I need to do is get the email to add a different attachment to each contact, based on their company name. The attachments are stored in a commmon folder and their naming convention is much like "C:\ location\Toys R us 09-11-2014.pdf". I need the macro to match the company name and date in excel to the company name and date in the file name, and send the attachment accordingly. As I found that outlook would continually block excel VBA, I had to use a longer than normal code to get the emails to send. Now the only issue is the attachment. My code is written below:

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal IpOperation As String, ByVal IpFile As String, ByVal IpParameters As String, ByVal IpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal IpOperation As String, ByVal IpFile As String, ByVal IpParameters As String, ByVal IpDirectory As String, ByVal nShowCmd As Long) As Long
#End If



Sub emailReminder()

Dim oOL As Outlook.Application, oMail As Outlook.MailItem, oNS As Outlook.Namespace
Dim oMapi As Outlook.MAPIFolder, oExpl As Outlook.Explorer
Dim sBody As String, sRecip As String, sSubj As String, dDate As Date, bsend As Boolean
Dim oWS As Worksheet, r As Long, i As Long, sStart As String

If MsgBox("Send directly (Y) or display (N)?", vbYesNo) = vbYes Then bsend = True

Set oWS = Sheet1
Set oOL = New Outlook.Application
Set oExpl = oOL.ActiveExplorer

If TypeName(oExpl) = "Nothing" Then
Set oNS = oOL.GetNamespace("MAPI")
Set oMapi = oNS.GetDefaultFolder(olFolderInbox)
Set oExpl = oMapi.GetExplorer
End If

With oWS.Range("A1") 'Reference point
r = .CurrentRegion.Rows.Count
For i = 2 To r
dDate = .Cells(i, 3)
sRecip = .Cells(i, 4)
sSubj = "Price Change Notification"
sBody = "Please see attatched attatched price change notification effective " & dDate

If bsend = False Then
Set oMail = oOL.CreateItem(olMailItem)
With oMail
.Subject = sSubj
.Body = sBody
.Recipients.Add sRecip
.Display
End With
Else
Sending sBody, sSubj, sRecip
End If
Next i
End With
Set oOL = Nothing
End Sub

Sub Sending(sBody As String, sSubj As String, sAddr As String)
Dim sURL As String
sURL = "Mailto:" & sAddr & "?subject=" & sSubj & "&Body=" & sBody

ShellExecute 0&, vbNullString, sURL, vbNullString, vbNullString, vbNormalFocus
Application.Wait (Now + TimeValue("0:00:03"))
Application.SendKeys "%s"
End Sub

I have added that in, but I'm not sure the extent to which it needs to be added in. My code now looks like this, and there is still no attachment being sent:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal IpOperation As String, ByVal IpFile As String, ByVal IpParameters As String, ByVal IpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal IpOperation As String, ByVal IpFile As String, ByVal IpParameters As String, ByVal IpDirectory As String, ByVal nShowCmd As Long) As Long
#End If



Sub emailReminder()

Dim oOL As Outlook.Application, oMail As Outlook.MailItem, oNS As Outlook.Namespace
Dim oMapi As Outlook.MAPIFolder, oExpl As Outlook.Explorer
Dim sBody As String, sRecip As String, sSubj As String, dDate As Date, sName As String, sType As String, bsend As Boolean
Dim oWS As Worksheet, r As Long, i As Long, sStart As String

If MsgBox("Send directly (Y) or display (N)?", vbYesNo) = vbYes Then bsend = True

Set oWS = Sheet1
Set oOL = New Outlook.Application
Set oExpl = oOL.ActiveExplorer

If TypeName(oExpl) = "Nothing" Then
Set oNS = oOL.GetNamespace("MAPI")
Set oMapi = oNS.GetDefaultFolder(olFolderInbox)
Set oExpl = oMapi.GetExplorer
End If

With oWS.Range("A1") 'Reference point
r = .CurrentRegion.Rows.Count
For i = 2 To r
dDate = .Cells(i, 3)
sName = .Cells(i, 5)
sRecip = .Cells(i, 4)
sSubj = "Price Change Notification"
sBody = "Please see attatched attatched price change notification effective " & dDate
sType = ".pdf"

If bsend = False Then
Set oMail = oOL.CreateItem(olMailItem)
With oMail
.Subject = sSubj
.Body = sBody
.Recipients.Add sRecip
.Attachments.Add "K:\pricing\Price Bulletins\ " & sName & dDate & sType
.Display
End With
Else
Sending sBody, sSubj, sRecip
End If
Next i
End With
Set oOL = Nothing
End Sub

Sub Sending(sBody As String, sSubj As String, sName As String, sType As String, sAddr As String)
Dim sURL As String
sURL = "Mailto:" & sAddr & "?subject=" & sSubj & "&Body=" & sBody

ShellExecute 0&, vbNullString, sURL, vbNullString, vbNullString, vbNormalFocus
Application.Wait (Now + TimeValue("0:00:03"))
Application.SendKeys "%s"
End Sub

Hello

"C:\ location\Toys R us 09-11-2014.pdf"

Taking your example of a file path above, I notice in your code: .Attachments.Add "K:\pricing\Price Bulletins\ " & sName & dDate & sType
that you have an extra space after the last back slash and between sName & dDate you do not add the space that goes between here unless you added it somewhere else.

I would suggest adding the following line in your code: debug.print "K:\pricing\Price Bulletins\ " & sName & dDate & sType
to see what comes up in your immediate window. To make sure your path comes out correct.