copy worksheet export as file and then email

R

rjmdc

Well-known Member
Joined
Apr 29, 2020
Messages
747
Office Version
  1. 365
Platform
  1. Windows
hi
i have code that copies a specific worksheet then files it
how do I add: attach a copy of this new workbook and email it
Rich (BB code): 
'Save New WB
        NewWB.SaveAs QBExportFolder & "QB Export " & Format(ReportMonth, "m_d_yyyy") & ".xlsx", 51
        NewWB.Close SaveChanges:=False
 
Sort by date Sort by votes
VBA Code: 
    Dim wbFile As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    NewWB.SaveAs QBExportFolder & "QB Export " & Format(ReportMonth, "m_d_yyyy") & ".xlsx", 51
    wbFile = NewWB.FullName
    NewWB.Close SaveChanges:=False
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "email@address"
        .Subject = "Subject"
        .Body = "Body text"
        .Attachments.Add wbFile
        .Send
    End With
 
Upvote 0
hi
its not working. this is my code. please see where its broken. all the parts work until create attachment and mail. it files like it hould but the mail part is broken.

Rich (BB code): 
Sub QBExport()
    Dim NextPromptDate              As Date:                    NextPromptDate = Worksheets("PrintSettings").Range("NextPromptDate")
    Dim ReportMonth                 As Date:                    ReportMonth = Application.WorksheetFunction.EoMonth(NextPromptDate, -2) + 1
    Dim DateStart                   As Date:                    DateStart = Application.WorksheetFunction.EoMonth(NextPromptDate, -2) + 1
    Dim DateEnd                     As Date:                    DateEnd = Application.WorksheetFunction.EoMonth(NextPromptDate, -1)
    Dim NewPromptDate               As Date:                    NewPromptDate = Application.WorksheetFunction.EDate(NextPromptDate, 1)
    Dim wsToExport                  As Worksheet
    Dim w                           As Long
    Dim NewWB                       As Workbook
    Dim cEs                         As New clsExcelSettings
    Dim tbl                         As ListObject
    
    'Check Next Prompt
    If Date < NextPromptDate Then Exit Sub
    
    'Ask UI
    If MsgBox("It is time for the QB Export, press 'YES' to begin the process.", vbYesNo, "Quickbooks Export") = vbYes Then
        'Settings Off
        cEs.SettingsOff
    
        'Create New WB and Worksheets
        Set NewWB = Workbooks.Add
        NewWB.Worksheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "Paid"
        NewWB.Worksheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "Void"
        NewWB.Worksheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "Replaced Checks"
        NewWB.Worksheets("Sheet1").Delete
                
        'Paid
        ThisWorkbook.Activate
        Call WSUnProtect(Worksheets("Paid"))
        Worksheets("Paid").ListObjects(1).refresh
        DoEvents
        Set wsToExport = Worksheets("Paid")
        Set tbl = wsToExport.ListObjects(1)
        Call WSUnProtect(wsToExport)
        tbl.Range.AutoFilter Field:=3, Criteria1 _
                :=">=" & CStr(Format(DateStart, "m/d/yyyy")), Operator:=xlAnd, Criteria2:="<=" & CStr(Format(DateEnd, "m/d/yyyy"))
        tbl.Range.SpecialCells(xlCellTypeVisible).Copy
        NewWB.Activate
        NewWB.Worksheets(wsToExport.Name).Range("A1").PasteSpecial
        NewWB.Worksheets(wsToExport.Name).Columns.EntireColumn.AutoFit
        ThisWorkbook.Activate
        tbl.AutoFilter.ShowAllData
        Call WSProtect(wsToExport)
        
        'Void
        Set wsToExport = Worksheets("Void")
        Set tbl = wsToExport.ListObjects(1)
        Call WSUnProtect(wsToExport)
        tbl.Range.SpecialCells(xlCellTypeVisible).Copy
        NewWB.Activate
        NewWB.Worksheets(wsToExport.Name).Range("A1").PasteSpecial
        NewWB.Worksheets(wsToExport.Name).Columns.EntireColumn.AutoFit
        ThisWorkbook.Activate
        Call WSProtect(wsToExport)
        
        'Paid
        Set wsToExport = Worksheets("Replaced Checks")
        Set tbl = wsToExport.ListObjects(1)
        Call WSUnProtect(wsToExport)
        tbl.Range.AutoFilter Field:=3, Criteria1 _
                :=">=" & CStr(Format(DateStart, "m/d/yyyy")), Operator:=xlAnd, Criteria2:="<=" & CStr(Format(DateEnd, "m/d/yyyy"))
        tbl.Range.SpecialCells(xlCellTypeVisible).Copy
        NewWB.Activate
        NewWB.Worksheets(wsToExport.Name).Range("A1").PasteSpecial
        NewWB.Worksheets(wsToExport.Name).Columns.EntireColumn.AutoFit
        ThisWorkbook.Activate
        tbl.AutoFilter.ShowAllData
        Call WSProtect(wsToExport)
        
        'Save New WB
        NewWB.SaveAs QBExportFolder & "QB Export " & Format(ReportMonth, "m_d_yyyy") & ".xlsx", 51
        NewWB.Close SaveChanges:=False
                              
        'Set New Next Prompt
        Call WSUnProtect(Worksheets("PrintSettings"))
        Worksheets("PrintSettings").Range("NextPromptDate") = NewPromptDate
        Call WSProtect(Worksheets("PrintSettings"))
        
        'Send Email
        Call QBExportEmailAccountant(CStr(Format(ReportMonth, "mmmm yyyy"))) this is the code that fails
        
        'Settings On
        cEs.SettingsOn
        
        'UI Confirm
        MsgBox "Process Complete"
    End If
    End Sub
Sub QBExportEmail(ReportMonth As String) this one works
    Dim sMail As String, sSubj As String, sBody As String

    sMail = "email@email"
    sSubj = "QB Export " & ReportMonth
    sBody = "QB Export for " & ReportMonth & " is in " & QBExportFolder & "  a copy was sent to the accountant."
    Call SendMail(sMail, sSubj, sBody)
End Sub

Sub QBExportEmailAccountant(ReportMonth As String) this is the part thats broken i am doing something wrong with the attachment
Dim sMail As String, sSubj As String, sBody As String, sAttachment As String
sAttachment = NewWB

sMail = "email@email"
sSubj = "Full Check Log Export " & ReportMonth
 sBody = "Full Check Log Export for " & ReportMonth & " is attached. Please reveiw for accuracy."
Attachments.Add sAttachment

Call SendMailAccountant(sMail, sSubj, sBody, sAttachment)
End Sub

Sub SendMailAccountant(sMail, sSubj, sBody, sAttachment)
  Dim OutlookApp As Object
  Set OutlookApp = CreateObject("Outlook.Application").CreateItem(0)
  With OutlookApp
    .To = sMail
    .Subject = sSubj
    .Body = sBody
    .Attachments = sAttachment
'    .Display 'Display Email
    .Send 'Send Email
  End With
End Sub
 
Upvote 0
Here is sample code from one of my projects. Review the code and see how to apply it to your project.

VBA Code: 
Sub sendReminderMail()
ChDir "C:\Users\logit\OneDrive\Desktop\EmailPDF\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\logit\OneDrive\Desktop\EmailPDF\" & "My PDF Sheet" & ".pdf", OpenAfterPublish:=False

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)


With OutLookMailItem
.To = "emails here"
.Subject = "This Is Your Subject Line"
.Body = "Here is PDF Statement."
.Attachments.Add "C:\Users\logit\OneDrive\Desktop\EmailPDF\" & "My PDF Sheet" & ".pdf"     'This is where the error is showing.
'.send
.Display
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing

End Sub
 
Upvote 0
hi
i dont seem to be able to fit this in into the rest of the code
 
Upvote 0
rjmdc said:
its not working. this is my code. please see where its broken. all the parts work until create attachment and mail. it files like it hould but the mail part is broken.
Click to expand...

Make these changes:

VBA Code: 
    'Save New WB
    Dim wbFile As String
    newWb.SaveAs QBExportFolder & "QB Export " & Format(ReportMonth, "m_d_yyyy") & ".xlsx", 51
    wbFile = newWb.FullName
    newWb.Close SaveChanges:=False

VBA Code: 
        'Send Email
        Call QBExportEmailAccountant(CStr(Format(ReportMonth, "mmmm yyyy")), wbFile)

VBA Code: 
Sub QBExportEmailAccountant(ReportMonth As String, sAttachment As String)
    Dim sMail As String, sSubj As String, sBody As String

'Attachments.Add sAttachment <------- DELETE THIS LINE

In SendMailAccountant, change to this:
VBA Code: 
    .Attachments.Add = sAttachment
 
Upvote 0
please assist. i am hoplessly tied in errors i am failing again and again
please take my code and make the corrections maybe cross out and show me in red.
issue is that each part is separate sub create the export and send the mail
thanks
 
Upvote 0
Your code in post #4 with my changes in #7.

VBA Code: 
Sub QBExport()
    Dim NextPromptDate              As Date:                    NextPromptDate = Worksheets("PrintSettings").Range("NextPromptDate")
    Dim ReportMonth                 As Date:                    ReportMonth = Application.WorksheetFunction.EoMonth(NextPromptDate, -2) + 1
    Dim DateStart                   As Date:                    DateStart = Application.WorksheetFunction.EoMonth(NextPromptDate, -2) + 1
    Dim DateEnd                     As Date:                    DateEnd = Application.WorksheetFunction.EoMonth(NextPromptDate, -1)
    Dim NewPromptDate               As Date:                    NewPromptDate = Application.WorksheetFunction.EDate(NextPromptDate, 1)
    Dim wsToExport                  As Worksheet
    Dim w                           As Long
    Dim NewWB                       As Workbook
    Dim cEs                         As New clsExcelSettings
    Dim tbl                         As ListObject
    
    'Check Next Prompt
    If Date < NextPromptDate Then Exit Sub
    
    'Ask UI
    If MsgBox("It is time for the QB Export, press 'YES' to begin the process.", vbYesNo, "Quickbooks Export") = vbYes Then
        'Settings Off
        cEs.SettingsOff
    
        'Create New WB and Worksheets
        Set NewWB = Workbooks.Add
        NewWB.Worksheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "Paid"
        NewWB.Worksheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "Void"
        NewWB.Worksheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "Replaced Checks"
        NewWB.Worksheets("Sheet1").Delete
                
        'Paid
        ThisWorkbook.Activate
        Call WSUnProtect(Worksheets("Paid"))
        Worksheets("Paid").ListObjects(1).Refresh
        DoEvents
        Set wsToExport = Worksheets("Paid")
        Set tbl = wsToExport.ListObjects(1)
        Call WSUnProtect(wsToExport)
        tbl.Range.AutoFilter Field:=3, Criteria1 _
                :=">=" & CStr(Format(DateStart, "m/d/yyyy")), Operator:=xlAnd, Criteria2:="<=" & CStr(Format(DateEnd, "m/d/yyyy"))
        tbl.Range.SpecialCells(xlCellTypeVisible).Copy
        NewWB.Activate
        NewWB.Worksheets(wsToExport.Name).Range("A1").PasteSpecial
        NewWB.Worksheets(wsToExport.Name).Columns.EntireColumn.AutoFit
        ThisWorkbook.Activate
        tbl.AutoFilter.ShowAllData
        Call WSProtect(wsToExport)
        
        'Void
        Set wsToExport = Worksheets("Void")
        Set tbl = wsToExport.ListObjects(1)
        Call WSUnProtect(wsToExport)
        tbl.Range.SpecialCells(xlCellTypeVisible).Copy
        NewWB.Activate
        NewWB.Worksheets(wsToExport.Name).Range("A1").PasteSpecial
        NewWB.Worksheets(wsToExport.Name).Columns.EntireColumn.AutoFit
        ThisWorkbook.Activate
        Call WSProtect(wsToExport)
        
        'Paid
        Set wsToExport = Worksheets("Replaced Checks")
        Set tbl = wsToExport.ListObjects(1)
        Call WSUnProtect(wsToExport)
        tbl.Range.AutoFilter Field:=3, Criteria1 _
                :=">=" & CStr(Format(DateStart, "m/d/yyyy")), Operator:=xlAnd, Criteria2:="<=" & CStr(Format(DateEnd, "m/d/yyyy"))
        tbl.Range.SpecialCells(xlCellTypeVisible).Copy
        NewWB.Activate
        NewWB.Worksheets(wsToExport.Name).Range("A1").PasteSpecial
        NewWB.Worksheets(wsToExport.Name).Columns.EntireColumn.AutoFit
        ThisWorkbook.Activate
        tbl.AutoFilter.ShowAllData
        Call WSProtect(wsToExport)
        
        'Save New WB
        Dim wbFile As String
        NewWB.SaveAs QBExportFolder & "QB Export " & Format(ReportMonth, "m_d_yyyy") & ".xlsx", 51
        wbFile = NewWB.FullName
        NewWB.Close SaveChanges:=False
    
        'Set New Next Prompt
        Call WSUnProtect(Worksheets("PrintSettings"))
        Worksheets("PrintSettings").Range("NextPromptDate") = NewPromptDate
        Call WSProtect(Worksheets("PrintSettings"))
        
        'Send Email
        Call QBExportEmailAccountant(CStr(Format(ReportMonth, "mmmm yyyy")), wbFile)
        
        'Settings On
        cEs.SettingsOn
        
        'UI Confirm
        MsgBox "Process Complete"
    End If
    End Sub
    
Sub QBExportEmail(ReportMonth As String) 'this one works
    Dim sMail As String, sSubj As String, sBody As String

    sMail = "email@email"
    sSubj = "QB Export " & ReportMonth
    sBody = "QB Export for " & ReportMonth & " is in " & QBExportFolder & "  a copy was sent to the accountant."
    Call SendMail(sMail, sSubj, sBody)
End Sub

Sub QBExportEmailAccountant(ReportMonth As String, sAttachment As String)
    Dim sMail As String, sSubj As String, sBody As String

    sMail = "email@email"
    sSubj = "Full Check Log Export " & ReportMonth
    sBody = "Full Check Log Export for " & ReportMonth & " is attached. Please reveiw for accuracy."

    Call SendMailAccountant(sMail, sSubj, sBody, sAttachment)
End Sub

Sub SendMailAccountant(sMail, sSubj, sBody, sAttachment)
  Dim OutlookApp As Object
  Set OutlookApp = CreateObject("Outlook.Application").CreateItem(0)
  With OutlookApp
    .To = sMail
    .Subject = sSubj
    .Body = sBody
    .Attachments.Add = sAttachment
'    .Display 'Display Email
    .Send 'Send Email
  End With
End Sub
 
Upvote 0
hi
i am sorry
it still fails here: Attachments.Add sAttachment

Rich (BB code): 
<span>Sub</span> SendMailAccountant<span>(</span>sMail<span>,</span> sSubj<span>,</span> sBody<span>,</span> sAttachment<span>)</span><br>  <span>Dim</span> OutlookApp <span>As</span> <span>Object</span><br>  <span>Set</span> OutlookApp <span>=</span> CreateObject<span>(</span><span>"Outlook.Application"</span><span>)</span><span>.</span>CreateItem<span>(</span><span>0</span><span>)</span><br>  <span>With</span> OutlookApp<br>    <span>.</span><span>To</span> <span>=</span> sMail<br>    <span>.</span>Subject <span>=</span> sSubj<br>    <span>.</span>Body <span>=</span> sBody<br>    <span>.</span>Attachments<span>.</span>Add <span>=</span> sAttachment<br><span>'    .Display 'Display Email</span><br>    <span>.</span>Send <span>'Send Email</span><br>  <span>End</span> <span>With</span><br><span>End</span> <span>Sub</span>
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
VBA code for new workbook extraction with data grouping
Replies
0
Views
38
coding123456
C
N
  • Question Question
VBA loop to duplicate sheets between one existing excel file and anew one
Replies
2
Views
210
ND1979
N
sharky12345
  • Question Question
Error 1004 - Copy method of Worksheet class failed
Replies
1
Views
276
yoseeeph
Y
B
  • Question Question
Copy and paste from one worksheet into a new workbook and save to a particular directory
Replies
3
Views
865
Joe4
Joe4
H
  • Question Question
Macro to save sheet as a CVS
Replies
5
Views
740
Joe4
Joe4

Share this page

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