通过 email 将 excel 范围作为新工作表发送

Question

I've grabbed this code from: http://learnexcelmacro.com/wp/2012/08/mail-one-sheet/ and while it does about 90% of what I need, I'm getting feedback from my admin team about the format of the documents they're receiving.

The worksheet includes a section that is not required (it's the portion that the user sets the email addresses etc for the form to be sent to) and I was hoping to grab just a selection of the worksheet as the version to be sent via email.

I've got a named range with the content that I want to send, and as you can see from the notes, I've tried using ActiveSheet.Range("tsDATA").Copy instead of ActiveSheet.Copy but this hasn't worked.

I've tried hiding the columns while the page gets exported, but I get errors and the forms don't get exported.

I've also tried copying the data values to a new worksheet in the book, but the resulting workbook created by the script bugs out becuase the VBS isn't located in the new workbook. I thought this might be closer to what I wanted, but ran into walls here too.

I believe that my solutions lies in the selection of the initial range, but I'm struggling to find something that works.

I'd like the exported sheet not to include the macros etc as well.

Full code below. Any help appreciated!

Sub Email_One_ActiveSheet()
    
    'Original code from: http://learnexcelmacro.com/wp/2012/08/mail-one-sheet/

    Dim OlApp As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim FileExt As String
    Dim TempFileName As String
    Dim FileFullPath As String
    Dim FileFormat As Variant
    Dim Wb1 As Workbook
    Dim Wb2 As Workbook

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    'Hide the email address details from the new workbook
    'Columns("U:AB").Select
    'Selection.EntireColumn.Hidden = True
    
    Set Wb1 = ThisWorkbook
    ActiveSheet.Copy              'This is the original and works!
    'ActiveSheet.Range("tsDATA").Copy      'This is where ZF is playing
    Set Wb2 = ActiveWorkbook

    'Below code will get the File Extension and
    'the file format which we want to save the copy
    'of the workbook with the active sheet.

    With Wb2
        If Val(Application.Version) < 12 Then
             FileExt = ".xls": FileFormat = -4143
        Else
            Select Case Wb1.FileFormat
            Case 51: FileExt = ".xlsx": FileFormat = 51
            Case 52:
                If .HasVBProject Then
                    FileExt = ".xlsm": FileFormat = 52
                Else
                    FileExt = ".xlsx": FileFormat = 51
                End If
            Case 56: FileExt = ".xls": FileFormat = 56
            Case Else: FileExt = ".xlsb": FileFormat = 50
            End Select
        End If
    End With

    'Save your workbook in your temp folder of your system
    'below code gets the full path of the temporary folder
    'in your system

    TempFilePath = Environ$("temp") & "\"

    'Now append a date and time stamp
    'in your new file

    'TempFileName = "Timesheet_" & ActiveSheet.Range("tsName").Value & "_" & Format(Now, "dd-mmm-yy")           'Uses the date the file was created
    TempFileName = "Timesheet_" & ActiveSheet.Range("tsName").Value & "_" & Format(ActiveSheet.Range("tsWE").Value, "dd-mmm-yy")     'uses the WE date from the worksheet

    'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName & FileExt

    'Now save your currect workbook at the above path
    Wb2.SaveAs FileFullPath, FileFormat:=FileFormat

    'Now open a new mail

    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)

    On Error Resume Next
    With NewMail
        .To = ActiveSheet.Range("tsEmailTO").Value
        .CC = ActiveSheet.Range("tsEmailCC").Value
        .BCC = ActiveSheet.Range("tsEmailBCC").Value
        .Subject = ActiveSheet.Range("tsEmailSUBJECT").Value
        .Body = ActiveSheet.Range("tsEmailBODY").Value
        .Attachments.Add FileFullPath '--- full path of the temp file where it is saved
        .Display   'use .Display to show you the email before sending it, or .Send to send the email without displaying it
    End With
    On Error GoTo 0

    'Since mail has been sent with the attachment
    'Now close and delete the temp file from the
    'temp folder
    Wb2.Close SaveChanges:=False
    Kill FileFullPath

    'set nothing to the objects created
    Set NewMail = Nothing
    Set OlApp = Nothing
    
    'restore the email details view
    'Columns("U:AB").Select
    'Selection.EntireColumn.Hidden = False

    'Now set the application properties back to true
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Answer 1

If I understand corretly you must change this part

'Hide the email address details from the new workbook
'Columns("U:AB").Select
'Selection.EntireColumn.Hidden = True

Set Wb1 = ThisWorkbook
ActiveSheet.Copy              'This is the original and works!
'ActiveSheet.Range("tsDATA").Copy      'This is where ZF is playing
Set Wb2 = ActiveWorkbook

to something like that

Set Wb1 = ThisWorkbook
ActiveSheet.Copy   ' I would change ActiveSheet to codename or name   
                   ' ThisWorkbook.Sheets("sheetToCopy").Copy
                   ' don't use ActiveSheet if not necessary   

Set Wb2 = ActiveWorkbook
With Wb2.Sheets(1)
     .Columns("U:AB").Delete
    ' and here another delete if necessary to hide sensitive data
    '.Columns("XYZ").Delete 
    '.Rows("66:77").Delete
End With

---

But in my opinion the worse problem is with

Set OlApp = CreateObject("Outlook.Application")

By my experience this will fail one day, I would try to getObject if Outlook object is already created

---

update

If you get #Ref error you can add changing formulas to value eg if your formulas are in columns F:H

With Wb2.Sheets(1)
     .Columns("F:H").Value = .Columns("F:H").Value
     ' add above before delete
     ' it changes formula to value, so no error will occure

     .Columns("U:AB").Delete
End With