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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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
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
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

LUIS FREUNDAuthor Commented:
Thanks Fabrice...new to this.  Can you guide me on this process?
0
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LUIS FREUNDAuthor Commented:
Thanks!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.