Send Email Code to kill connection

I have this code to send an excel attachment via Outlook.  The workbook itself has data coming in from Access.  How would I modify the send mail code attachment to kill the connection strings when attaching it to email?  I want to avoid the recipient going through the messages that's it looking for the connection.  Here is the code.....

Sub Email_RFQ()
Dim OutApp As Object
Dim OutMail As Object
Dim sTO As String, sSubj As String
Dim filePath As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
filePath = ActiveWorkbook.Path & "\RFQ - " & [M6] & ".xlsx"
ActiveWorkbook.Sheets.Copy
ActiveWorkbook.SaveAs filePath, 51
ActiveWorkbook.Close True
sTO = [E26]
sSubj = [M5]

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = sTO
    .CC = ""
    .BCC = ""
    .Subject = sSubj & Range("M6")
    .Body = "Hi, " & Range("E23") & vbNewLine & vbNewLine & _
    "Would you please quote per the attached RFQ " & Range("M6") & vbNewLine & vbNewLine & _
    "Please note that thIs RFQ IS competitive and time sensitive. Cost and schedule are both important parameters for these RFQ responses" & vbNewLine & vbNewLine & _
    "Please complete the RFQ per the BID Closing Date " & Range("N11") & ". On the RFQ please include the delivery date and Lead times." & vbNewLine & vbNewLine & _
    "Note this is a DX rated program.Should you have any questions about the RFQ, please feel free to contact me"
    .Attachments.Add filePath
    .Display   'or use .Send
End With
If Len(Dir(filePath)) > 0 Then
    SetAttr filePath, vbNormal
    Kill filePath
End If
Kill filePath
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
LUIS FREUNDAsked:
Who is Participating?
 
Fabrice LambertFabrice LambertCommented:
Sub RemoveConnections(ByRef wb as Excel.Workbook)
   Do While wb.Connections.Count > 0
      wb.Connections.Item(wb.Connections.Count).Delete
   Loop
 End Sub 

Sub Email_RFQ()
Dim OutApp As Object
Dim OutMail As Object
Dim sTO As String, sSubj As String
Dim filePath As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wb as Excel.Workbook
Set wb = ActiveWorkbook

filePath = wb.Path & "\RFQ - " & [M6] & ".xlsx"
RemoveConnections wb
wb.Sheets.Copy
wb.SaveAs filePath, 51
wb.Close True
Set wb = Nothing

sTO = [E26]
sSubj = [M5]

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = sTO
    .CC = ""
    .BCC = ""
    .Subject = sSubj & Range("M6")
    .Body = "Hi, " & Range("E23") & vbNewLine & vbNewLine & _
    "Would you please quote per the attached RFQ " & Range("M6") & vbNewLine & vbNewLine & _
    "Please note that thIs RFQ IS competitive and time sensitive. Cost and schedule are both important parameters for these RFQ responses" & vbNewLine & vbNewLine & _
    "Please complete the RFQ per the BID Closing Date " & Range("N11") & ". On the RFQ please include the delivery date and Lead times." & vbNewLine & vbNewLine & _
    "Note this is a DX rated program.Should you have any questions about the RFQ, please feel free to contact me"
    .Attachments.Add filePath
    .Display   'or use .Send
End With
If Len(Dir(filePath)) > 0 Then
    SetAttr filePath, vbNormal
End If
Kill filePath
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub 

Open in new window

0
 
Fabrice LambertFabrice LambertCommented:
Hmmmm,

What do you call "the connection strings" in the first place ?

Also, I'm not sure that deleting the attachment file before sending the mail will give you the expected results.
0
 
LUIS FREUNDAuthor Commented:
Hi Fabrice,

It's actually the Workbook connections.  I have three of them that are connected to an access db.  I've used the code below to remove the connections...can this code be integrated into my Email code?

Sub RemoveConnections()
   Do While ActiveWorkbook.Connections.Count > 0
      ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
   Loop
 End Sub
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Fabrice LambertFabrice LambertCommented:
Sub RemoveConnections(ByRef wb as Excel.Workbook)
   Do While wb.Connections.Count > 0
      wb.Connections.Item(wb.Connections.Count).Delete
   Loop
 End Sub 

Open in new window

Call this function before saving your workbook.
0
 
LUIS FREUNDAuthor Commented:
Thanks Fabrice...new to this.  Can you guide me on this process?
0
 
LUIS FREUNDAuthor Commented:
Thanks!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.