通过电子邮件将excel范围作为新工作表发送

我从中获取了这段代码：虽然它完成了我所需的90%，但我从我的管理团队那里得到了关于他们收到的文档格式的反馈

工作表包含一个不需要的部分（这是用户设置发送表单的电子邮件地址等的部分），我希望只获取工作表的一部分作为通过电子邮件发送的版本

我有一个指定的区域，其中包含我要发送的内容，正如您从注释中看到的，我尝试使用

ActiveSheet.range（“tsDATA”）.Copy

而不是

ActiveSheet.Copy

，但这不起作用

我尝试在导出页面时隐藏列，但是我得到了错误，并且表单没有被导出

我还尝试将数据值复制到书中的一个新工作表中，但由于VBS不在新工作表中，因此脚本创建的工作簿出现了错误。我以为这可能更接近我想要的，但在这里也遇到了麻烦

我相信我的解决方案在于选择初始范围，但我正在努力找到可行的方法

我希望导出的表不包括宏等

完整代码如下。感谢您的帮助

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

Sub-Email\u-One\u-ActiveSheet（）
'源代码：http://learnexcelmacro.com/wp/2012/08/mail-one-sheet/
作为对象的Dim-OlApp
将NewMail设置为对象
Dim TempFilePath作为字符串
Dim FileExt作为字符串
将文件名设置为字符串
Dim FileFullPath作为字符串
Dim文件格式作为变量
将Wb1设置为工作簿
将Wb2设置为工作簿
应用
.ScreenUpdate=False
.EnableEvents=False
以
'从新工作簿中隐藏电子邮件地址详细信息
'列（“U:AB”）。选择
'Selection.EntireColumn.Hidden=True
设置Wb1=ThisWorkbook
ActiveSheet.Copy'这是原件和作品！
'ActiveSheet.Range（“tsDATA”）.Copy'这是ZF播放的地方
设置Wb2=ActiveWorkbook
'下面的代码将获得文件扩展名和
'要保存副本的文件格式
包含活动工作表的工作簿的。
使用Wb2
如果Val（Application.Version）<12，则
FileExt=“.xls”：FileFormat=-4143
其他的
选择案例Wb1.FileFormat
案例51:FileExt=“.xlsx”：FileFormat=51
案例52：
如果.hasvb项目
FileExt=“.xlsm”：FileFormat=52
其他的
FileExt=“.xlsx”：FileFormat=51
如果结束
案例56:FileExt=“.xls”：FileFormat=56
案例：FileExt=“.xlsb”：FileFormat=50
结束选择
如果结束
以
'将工作簿保存在系统的临时文件夹中
'下面的代码获取临时文件夹的完整路径
“在你的系统中
TempFilePath=Environ$（“temp”）和“\”
'现在附加日期和时间戳
'在新文件中
“TempFileName=”Timesheet_u“&ActiveSheet.Range（“tsName”）。Value&“&uu”和Format（现在是“dd-mmm-yy”）使用文件的创建日期
TempFileName=“Timesheet”&ActiveSheet.Range（“tsName”）.Value&“&Format（ActiveSheet.Range（“tsWE”）.Value，“dd-mmm-yy”）使用工作表中的WE日期
'保存文件的完整路径
FileFullPath=TempFilePath&TempFileName&FileExt
'现在将当前工作簿保存在上述路径
Wb2.SaveAs FileFullPath，FileFormat:=FileFormat
'现在打开一个新邮件
设置OlApp=CreateObject（“Outlook.Application”）
Set NewMail=OlApp.CreateItem（0）
出错时继续下一步
与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'---保存临时文件的完整路径
.Display“使用.Display在发送电子邮件之前向您显示电子邮件，或.Send在不显示电子邮件的情况下发送电子邮件
以
错误转到0
'因为邮件已随附件一起发送
'现在关闭临时文件并将其从
'临时文件夹
Wb2.关闭保存更改：=False
终止文件完整路径
'对创建的对象不设置任何内容
设置NewMail=Nothing
设置OlApp=Nothing
'还原电子邮件详细信息视图
'列（“U:AB”）。选择
'Selection.EntireColumn.Hidden=False
'现在将应用程序属性设置回true
应用
.ScreenUpdate=True
.EnableEvents=True
以
端接头

如果我理解正确，您必须更改此部分

'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

做那样的事

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

---

但在我看来，更糟糕的问题是

Set OlApp = CreateObject("Outlook.Application")

根据我的经验，有一天会失败，如果Outlook对象已经创建，我会尝试获取对象

---

更新

如果您得到#Ref error，您可以将更改公式添加到值中，例如，如果您的公式位于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

---

完美的这就解决了电子邮件工作簿中没有包含额外信息的问题。我对outlook部分崩溃没有任何问题，但我希望看到更多关于如何纠正的信息。请查看Ron de Bruin的著名网站，你会在那里找到一些信息。现在这些专栏已被删除，我遇到了另一个问题，发送电子邮件的部分引用了那些已删除的单元格，现在正在新创建的工作簿中查找这些单元格。我假设我可以在发送电子邮件时引用原始工作簿，否则我将不得不隐藏，而不是删除这些列。@ZachFlem只需将公式更改为columns.delete之前的值-如更新的答案中所示