我使用一些标准代码从互联网使用一个按钮来创建一个电子邮件中有一个附件,是一个范围的工作表那里的按钮被按下。代码精美的作品。 我如何可以扩展码附加两个或更多的范围? 在代码下面,我已经开始初始化第二个来源和目标,但后来失去了信心,关于应如何加以应用。
Private Sub CommandButton2_Click()
Dim Source As Range
Dim Source2 As Range
Dim Dest As Workbook
Dim Dest2 As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim AutoPrint As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
Set Source2 = Nothing
On Error Resume Next
Set Source = Range("A1:M47").SpecialCells(xlCellTypeVisible)
Set Source2 = Range("AB1:AN47").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Set Dest2 = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
If Range("AC6") <> "" Then
Source2.Copy
With Dest2.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
End If
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
AutoPrint = Range("Y6").Value
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = Range("S6").Value
.CC = Range("S3").Value
If Range("T3").Value = "Enter bcc addresses manually here" Then
.bcc = ""
Else
.bcc = Range("T3").Value
End If
.Subject = Range("V6").Value
.Body = Range("U6").Value
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
If AutoPrint = "Yes" Then
.Send 'or use .Display
Else
.Display
End If
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub