SOLVED

Macro to send Tab of Excel As a CSV via email

Iron Contributor

Hi,

 

I have a daily task which requires me to get data from a pdf each day and then send as a CSV file to another email. I am looking to have a macro to be able to send one tab of an excel as a CSV file to the email address listed on the tab. From my research i have found the below macro to send a tab as CSV.

 

 

Public Sub Email_Sheets_As_CSV()

    Dim csvFiles(1 To 3) As String, i As Integer
    Dim wsName As Variant
    Dim OutApp As Object, OutMail As Object
    
    i = 0
    For Each wsName In Array("Sheet1", "Sheet2", "Sheet3")     'sheet names to be emailed - CHANGE THE NAMES
        i = i + 1
        csvFiles(i) = ThisWorkbook.Path & "\" & wsName & ".csv"
        ThisWorkbook.Worksheets(wsName).Copy
        ActiveWorkbook.SaveAs csvFiles(i), FileFormat:=xlCSV
        ActiveWorkbook.Close False
    Next

    'Email the .csv files
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = ThisWorkbook.Worksheets("Settings").Range("A1").Value     'cell containing email address - CHANGE THE SHEET & CELL
        .CC = ""
        .BCC = ""
        .Subject = "Email subject here"
        .Body = "This email contains 3 .csv file attachments."
        .Attachments.Add csvFiles(1)
        .Attachments.Add csvFiles(2)
        .Attachments.Add csvFiles(3)
        .Send
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    'Delete the .csv files
    
    Kill csvFiles(1)
    Kill csvFiles(2)
    Kill csvFiles(3)
    
End Sub

 Can someone please assist in updating this to so it reads the tab "Upload CSV" to send an email address listed in cell B5?

 

Thank you kindly for any assistance.

2 Replies
best response confirmed by calof1 (Iron Contributor)
Solution
@calof1

Try below code. This module is programmed to use MS Outlook for the email and is set to activate and run only for sheet named Upload CSV. I don't have Outlook so was not able to fully test the code, however, the .csv file is created / saved successfully. I also changed the send function to 'display' for testing purposes but you can switch this back once you're happy it works as anticipated. Hope this is works for you:

Public Sub Email_Sheets_As_CSV()

Dim csvFile As String
Dim wsName As Variant
Dim OutApp As Object, OutMail As Object

Sheets("Upload CSV").Activate

wsName = ActiveSheet.Name
csvFile = ThisWorkbook.Path & "\" & wsName & ".csv"
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs csvFile, FileFormat:=xlCSV
ActiveWorkbook.Close False

'Email the .csv files

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = ThisWorkbook.Worksheets("Upload CSV").Range("B5").Value 'cell containing email address - CHANGE THE SHEET & CELL
.CC = ""
.BCC = ""
.Subject = "Email subject here"
.Body = "This email contains 1 .csv file attachments."
.Attachments.Add csvFile
.Display 'change to .Send to send email without displaying first
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

'Delete the .csv files

Kill csvFile

End Sub

Hi@Charla74 

 

Thank you greatly for your help with this. 

 

I will update and complete some testing shortly.

 

Thanks again for your help, much appreciated.

1 best response

Accepted Solutions
best response confirmed by calof1 (Iron Contributor)
Solution
@calof1

Try below code. This module is programmed to use MS Outlook for the email and is set to activate and run only for sheet named Upload CSV. I don't have Outlook so was not able to fully test the code, however, the .csv file is created / saved successfully. I also changed the send function to 'display' for testing purposes but you can switch this back once you're happy it works as anticipated. Hope this is works for you:

Public Sub Email_Sheets_As_CSV()

Dim csvFile As String
Dim wsName As Variant
Dim OutApp As Object, OutMail As Object

Sheets("Upload CSV").Activate

wsName = ActiveSheet.Name
csvFile = ThisWorkbook.Path & "\" & wsName & ".csv"
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs csvFile, FileFormat:=xlCSV
ActiveWorkbook.Close False

'Email the .csv files

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = ThisWorkbook.Worksheets("Upload CSV").Range("B5").Value 'cell containing email address - CHANGE THE SHEET & CELL
.CC = ""
.BCC = ""
.Subject = "Email subject here"
.Body = "This email contains 1 .csv file attachments."
.Attachments.Add csvFile
.Display 'change to .Send to send email without displaying first
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

'Delete the .csv files

Kill csvFile

End Sub

View solution in original post