Hi I am looking for some help if possible. I have a macro running that saves and closes a file 2 minutes after it has been opened. I was hoping that when the file saves that it would email the file to a user but this doesn't seem to be working
In Modue1 I have
Module1
Dim CloseTime As Date
Sub TimeSetting()
CloseTime = Now + TimeValue("00:02:00")
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=False
End Sub
Sub SavedAndClose()
ActiveWorkbook.Close Savechanges:=True
End Sub
and In this work book I have
Private Sub Workbook_Open()
Call TimeSetting
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call TimeStop
Call TimeSetting
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20181102
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 = "Recipient@mail.co.uk"
.CC = ""
.Subject = "New Files Update"
.Body = "Hi," & Chr(13) & Chr(13) & "The new files has now updated." & Chr(13) & Chr(13) & "Thanks" & Chr(13) & Chr(13) & "Krisso."
.Attachments.Add xName
.Display
'.send
End With
Set xMailItem = Nothing
Set xOutApp = Nothing
End Sub
I thought this was just a running order issue but I have tried to place the email macro in different places and nothing seems to make the file email
Can anyone help
Thanks
Chris
In Modue1 I have
Module1
Dim CloseTime As Date
Sub TimeSetting()
CloseTime = Now + TimeValue("00:02:00")
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=False
End Sub
Sub SavedAndClose()
ActiveWorkbook.Close Savechanges:=True
End Sub
and In this work book I have
Private Sub Workbook_Open()
Call TimeSetting
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call TimeStop
Call TimeSetting
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20181102
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 = "Recipient@mail.co.uk"
.CC = ""
.Subject = "New Files Update"
.Body = "Hi," & Chr(13) & Chr(13) & "The new files has now updated." & Chr(13) & Chr(13) & "Thanks" & Chr(13) & Chr(13) & "Krisso."
.Attachments.Add xName
.Display
'.send
End With
Set xMailItem = Nothing
Set xOutApp = Nothing
End Sub
I thought this was just a running order issue but I have tried to place the email macro in different places and nothing seems to make the file email
Can anyone help
Thanks
Chris