Advertisement
Guest User

Untitled

a guest
Jun 18th, 2019
81
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.29 KB | None | 0 0
  1. Dim wb1 As Workbook
  2. Dim TempFilePath As String
  3. Dim TempFileName As String
  4. Dim FileExtStr As String
  5. Dim OutApp As Object
  6. Dim OutMail As Object
  7.  
  8. With Application
  9. .ScreenUpdating = False
  10. .EnableEvents = False
  11. End With
  12.  
  13. Set wb1 = ActiveWorkbook
  14.  
  15. TempFilePath = Environ$("temp") & ""
  16. TempFileName = Range("H22") & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
  17. FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
  18.  
  19. wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
  20.  
  21. Set OutApp = CreateObject("Outlook.Application")
  22. Set OutMail = OutApp.CreateItem(0)
  23.  
  24. On Error Resume Next
  25. With OutMail
  26. .to = "person1@PLACE.COM"
  27. .CC = "MPERSON@PLACE.COM" & " " & "LPERSON@PLACE.COM"
  28. .BCC = ""
  29. .Subject = "SUBJECT" & Range("H22")
  30. .Body = "Please review ETC.ETC."
  31. .Attachments.Add TempFilePath & TempFileName & FileExtStr
  32. .Display
  33.  
  34. End With
  35.  
  36. On Error GoTo 0
  37.  
  38.  
  39. Dim myFile As String
  40.  
  41. myFile = ActiveWorkbook.Name
  42.  
  43. Application.DisplayAlerts = False ' Disregard overwriting message.
  44. ActiveWorkbook.SaveAs Filename:="U:PublicWAKKAWAKKAWAKKA - To Review"
  45.  
  46.  
  47. Kill TempFilePath & TempFileName & FileExtStr
  48.  
  49. Set OutMail = Nothing
  50. Set OutApp = Nothing
  51.  
  52. With Application
  53. .ScreenUpdating = True
  54. .EnableEvents = True
  55. End With
  56.  
  57.  
  58. Call SaveFileExcel
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement