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
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