BeforeSave 事件不工作

BeforeSave Event not working

我正在尝试将数据导出到 csv 并在保存 excel 文件时发送,但它不起作用。当在保存事件中未设置为 运行 时,代码本身 运行 完全没问题。 任何帮助将不胜感激

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


ActiveSheet.Unprotect
ActiveSheet.Range(":8").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

试试这个:

  1. 制作第一行(在Sub下方)Application.EnableEvents = False
  2. 制作最后一行(在End Sub之上) Application.EnableEvents = True