Question

我正在尝试将数据导出到csv并在保存excel文件时发送，但它无法正常工作。未设置为在save事件上运行时，代码本身运行完全正常。任何帮助将不胜感激

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

试试这个：

制作第一行（Sub下方） Application.EnableEvents = False
制作最后一行（在End Sub上方） Application.EnableEvents = True

BeforeSave事件不起作用

1 个答案: