excelbefore-savevba

BeforeSave Event not working


I am trying to export data in to a csv and send whenever the excel file is saved, but it is not working. The code itself runs perfectly fine when not set to run on the save event. Any help would be greatly appreciated

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


ActiveSheet.Unprotect
ActiveSheet.Range("$1:$428").AutoFilter Field:=2
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select

Workbooks.Add
    Application.DisplayAlerts = False
    ChDir "F:\Customer Services\Returns"
    ActiveWorkbook.SaveAs Filename:="F:\Customer Services\Returns\Credits.csv", _
     FileFormat:=xlCSV, CreateBackup:=False
    Range("A1").Select

Windows("Credits 2017.xlsm").Activate
    Selection.Copy

Windows("Credits.csv").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("S:U").Select
    Selection.Delete Shift:=xlToLeft
    Application.DisplayAlerts = True

Dim xOutApp As Object
Dim xMailItem As Object
Dim xName As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.FullName
With xMailItem
    .To = "Email address"
    .CC = ""
    .Subject = "Credits"
    .Body = "Hi," & Chr(13) & Chr(13) & "File is now updated."
    .Attachments.Add xName
    .Display = False
    .send
End With
Set xMailItem = Nothing
Set xOutApp = Nothing

Windows("Credits.csv").Activate
ActiveWorkbook.Close SaveChanges = True

Windows("Credits 2017.xlsm").Activate
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
ActiveWorkbook.Close SaveChanges = True

End Sub

Solution

  • Try this:

    1. make the first line (below the Sub) Application.EnableEvents = False
    2. make the last line (above the End Sub) Application.EnableEvents = True