Macro to copy a worksheet to a new CSV file then email

Kangah

Board Regular
Joined
Feb 9, 2009
Messages
54
Good morning guys, I had thought this was going to be easy but have spent hours trying to find a suitable example to tinker with and can't find something that does what I need, or figure out how to make it work...

What I am hoping for is a macro that will,

1. Prompt a user to select a location to save the file
2. Create a new CSV file based on a predefined name + Date in a "yyyymmdd" format.
3. Attach that CSV file to an email address
4. Initially I need the macro to simply open the email with attachment for review and manually send... After a while of it working and being proven I'd like to be able to make it auto send.
5. Delete the CSV file off the desktop or other chosen location from step 1.

At this stage, I have step 1 and 2. I just can't figure out how to get 3-5 working..

Appreciate any advice!

Code:
Sub Export()

Dim MyPath As String
Dim MyFileName As String

MyFileName = "Non Recuring" & " " & Format(Date, "yyyymmdd")
'alternative name formatting: MyFileName = "Non Recuring" & Sheets("Sheet1").Range("B1").Value & "_" & Format(Date, "ddmmyyyy")

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

Sheets("Sheet1").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:

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

End Sub
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
I think I have figured it out, after another few hours and much Googling. Sharing to benefit others in case someone needs something similar.



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

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

MyFileName = "GenericNRCharge" & Format(Date, "yyyymmdd") & Format(Time, "hhmmss")

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 = ""
     .CC = ""
     .BCC = ""
     .Subject = MyFileName
     .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
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,337
Members
448,568
Latest member
Honeymonster123

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