Remove Queries from a temporary file

[O177812]

I am using the following that builds a temporary file for an email:

------------------------------------------------------

Sub SEND_REPORT()
'
' SEND_REPORT Macro
'
Dim oApp As Object
Dim oMail As Object
Dim LWorkbook As Workbook
Dim LFileName As String


'Turn off screen updating
Application.ScreenUpdating = False


'Copy the active worksheet and save to a temporary workbook
ActiveSheet.Copy
Set LWorkbook = ActiveWorkbook


'Create a temporary file in your current directory that uses the name
' of the sheet as the filename
LFileName = "Sazerac_Price_List" & ".xlsx"
On Error Resume Next
'Delete the file if it already exists
Kill LFileName
On Error GoTo 0
'Save temporary file
LWorkbook.SaveAs Filename:=LFileName


'Create an Outlook object and new mail message
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)


'Set mail attributes (uncomment lines to enter attributes)
' In this example, only the attachment is being added to the mail message
With oMail
.To = "rduke@sazerac.com"
.Cc = "landerson@gualaclosures.com"
.Subject = "GCNA/SAZERAC - ITEM ASSORTMENT PRICE LIST"
.body = "Dear Customer," & vbCrLf & vbCrLf & _
"Attached is the current pricing for your items produced by Guala Closures North America." & vbCrLf & _
"Please let us know if we can answer any questions and/or if we can provide any additional assistance." & vbCrLf & vbCrLf & _
"Have a great week!"
.Attachments.Add LWorkbook.FullName
.Display 'Comment out this line and uncomment the next line when ready to auto-send email
End With


'Delete the temporary file and close temporary Workbook
LWorkbook.ChangeFileAccess Mode:=xlReadOnly
LWorkbook.Close SaveChanges:=False


'Turn back on screen updating
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing

'
End Sub

------------------------------------------------------

The final issue that I am struggling with is that the file contains a query that I would like to delete from the temporary file before the email is sent.
I tried using the below but regardless of where I placed it, it doesn't appear to be working before it attaches the email to the outgoing email message.

' Delete all queries in the active workbook.
Dim q As WorkbookQuery
For Each q In ActiveWorkbook.Queries
q.Delete
DoEvents
Next q

Can someone please assist?

 

[MikeVol]

Hello @O177812. Try next code untested.

Option Explicit

Sub SEND_REPORT()

    ' SEND_REPORT Macro
    Dim oApp        As Object
    Dim oMail       As Object
    Dim LWorkbook   As Workbook
    Dim LFileName   As String

    ' Turn off screen updating
    Application.ScreenUpdating = False

    ' Copy the active worksheet and save to a temporary workbook
    ActiveSheet.Copy
    Set LWorkbook = ActiveWorkbook

    ' Delete all queries from the temporary workbook
    On Error Resume Next
    Dim qry         As QueryTable
    Dim ws          As Worksheet
    Dim conn        As WorkbookConnection

    ' Remove any QueryTables in the sheets
    For Each ws In LWorkbook.Worksheets
        
        For Each qry In ws.QueryTables
            qry.Delete
        Next qry
    
    Next ws

    ' Remove any Workbook Connections
    For Each conn In LWorkbook.Connections
        conn.Delete
    Next conn
    On Error GoTo 0

    ' Create a temporary file in your current directory that uses the name
    ' of the sheet as the filename
    LFileName = "Sazerac_Price_List" & ".xlsx"
    On Error Resume Next

    ' Delete the file if it already exists
    Kill LFileName
    On Error GoTo 0

    ' Save temporary file
    LWorkbook.SaveAs Filename:=LFileName

    ' Create an Outlook object and new mail message
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)

    ' Set mail attributes (uncomment lines to enter attributes)
    ' In this example, only the attachment is being added to the mail message
    With oMail
        .To = "rduke@sazerac.com"
        .Cc = "landerson@gualaclosures.com"
        .Subject = "GCNA/SAZERAC - ITEM ASSORTMENT PRICE LIST"
        .body = "Dear Customer," & vbCrLf & vbCrLf & _
                "Attached is the current pricing for your items produced by Guala Closures North America." & vbCrLf & _
                "Please let us know if we can answer any questions and/or if we can provide any additional assistance." & vbCrLf & vbCrLf & _
                "Have a great week!"
        .Attachments.Add LWorkbook.FullName
        .Display    ' Comment out this line and uncomment the next line when ready to auto-send email
    End With

    ' Delete the temporary file and close temporary Workbook
    LWorkbook.ChangeFileAccess Mode:=xlReadOnly
    LWorkbook.Close SaveChanges:=False

    ' Turn back on screen updating
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
End Sub

I hope I helped you. Good luck and have a wonderful Christmas!

 

[John_w]

My version:

Option Explicit

Sub SEND_REPORT()
    '
    ' SEND_REPORT Macro
    '
    Dim oApp As Object
    Dim oMail As Object
    Dim LFileName As String
    
    LFileName = ThisWorkbook.Path & "\Sazerac_Price_List.xlsx"
    
    'Turn off screen updating
    Application.ScreenUpdating = False
    
    'Copy the active worksheet and save to a temporary workbook
    ActiveSheet.Copy
    
    With ActiveWorkbook
        'Delete queries
        While .Queries.Count > 0
            .Queries(1).Delete
        Wend
        'Delete connections
        While .Connections.Count > 0
            .Connections(1).Delete
        Wend
        'Suppress warning if new workbook already exists
        Application.DisplayAlerts = False
        .SaveAs Filename:=LFileName, FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        .Close False
    End With
    
    'Create an Outlook object and new mail message
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    
    'Set mail attributes (uncomment lines to enter attributes)
    ' In this example, only the attachment is being added to the mail message
    With oMail
        .To = "rduke@sazerac.com"
        .Cc = "landerson@gualaclosures.com"
        .Subject = "GCNA/SAZERAC - ITEM ASSORTMENT PRICE LIST"
        .Body = "Dear Customer," & vbCrLf & vbCrLf & _
                "Attached is the current pricing for your items produced by Guala Closures North America." & vbCrLf & _
                "Please let us know if we can answer any questions and/or if we can provide any additional assistance." & vbCrLf & vbCrLf & _
                "Have a great week!"
        .Attachments.Add LFileName
        .Display 'Comment out this line and uncomment the next line when ready to auto-send email
        '.Send
    End With
    
    'Delete the temporary file
    Kill LFileName

    'Turn back on screen updating
    Application.ScreenUpdating = True
    
    Set oMail = Nothing
    Set oApp = Nothing

End Sub