Reputation: 27
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
Upvotes: 0
Views: 2974
Reputation: 96771
Try this:
Sub
) Application.EnableEvents = False
End Sub
) Application.EnableEvents = True
Upvotes: 0