VBA code to save active worksheet to a location and e-mail as attachment

inda09

New Member
Joined
Mar 22, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hi all, New here and fairly new to VBA. I have a xlsm file in which i need data to be added and at the end of the day converted to CSV and then added as an a attachment on outlook, I have used some code found from various sources and for the most of it it works. I don't specifically need it saved to a location and temp would do if easier, however with temp it seems to give a random number on the file name. Any help really appreciated. The code i have is as follows: (reason i can't have a number aside file name is due to an automation picking it up within a JIRA envirnoment)

Sub Export()
Dim MyPath As String
Dim MyFileName As String

'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

MyFileName = "Total Loss Payments"

If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

Sheets("Sheet1").Copy

'-----------------
'"Dynamic location": This section will enable the user to select a location to save the new file if they want to keep a copy
'-----------------

'With Application.FileDialog(msoFileDialogFolderPicker)
' .Title = "Select a Folder"
' .AllowMultiSelect = False
' .InitialFileName = "" '<~~ The start folder path for the file picker.
' If .Show <> -1 Then GoTo NextCode
' MyPath = .SelectedItems(1) & ""
'End With
'
'NextCode:


'-----------------
'Delete the below MyPath if using "Dynamic Location"
'-----------------
MyPath = Environ$("temp") & ""


With ActiveWorkbook
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlCSV, CreateBackup:=False
.Close False
End With

'Create Instance of Outlook
On Error Resume Next
Set OutlookApp = GetObject(class:="Outlook.Application") 'Handles if Outlook is already open
Err.Clear
If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(class:="Outlook.Application") 'If not, open Outlook

If Err.Number = 429 Then
MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
GoTo ExitSub
End If
On Error GoTo 0

'Create a new email message
Set OutlookMessage = OutlookApp.CreateItem(0)

'Create Outlook email with attachment
On Error Resume Next
With OutlookMessage
.To = "e-mail would go here"
.CC = ""
.BCC = ""
.Subject = "Total loss payments raised"
.Body = "Please see attached." & vbNewLine & vbNewLine
.Attachments.Add MyPath & MyFileName
.Display
End With
On Error GoTo 0

'Delete the temporary file
Kill MyPath & MyFileName

'Clear Memory
Set OutlookMessage = Nothing
Set OutlookApp = Nothing

'Optimize Code
ExitSub:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Forum statistics

Threads
1,221,672
Messages
6,161,199
Members
451,688
Latest member
Gregs44132

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top