Событие BeforeSave не работает

Question

Я пытаюсь экспортировать данные в CSV и отправлять всякий раз, когда файл Excel сохраняется, но это не работает. Сам код прекрасно работает, если не настроен на запуск при сохранении события. Любая помощь будет принята с благодарностью

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

Answer 1

Попробуй это:

1. сделать первую строку (ниже Sub ) Application.EnableEvents = False
2. сделать последнюю строку (над End Sub ) Application.EnableEvents = True