在发送想法之前,我将先复制一个活动的工作表,但这给了我
“运行时错误'1004':我们无法复制此工作表”。
我在下面尝试了一些命令来复制工作表,只是行不通:
ThisWorkSheet.Copy ' fist method
Worksheets("Confirm").Activate
ActiveSheet.Copy ' Second mehod
ActiveWorkbook.Sheets("Confirm").Copy ' Third method
所有这些出来的错误和调试是导航到上面的代码的在线。
Sub Mail_ActiveSheet()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy ' when debug this code come out error
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsm": FileFormatNum = 52
End If
End With
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = Range("F4").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = Range("B12").Value
.CC = ""
.BCC = ""
.Subject = "Order From " & Range("E8").Value
.HTMLBody = "<font face=""calibri"" style=""font-size:11pt;"">Dear Collegue, " & "<br><br>" & _
"Please kindly find the attached new order for " & Range("E8").Value & " above." & _
"<br><br>" & "Regards <br><br>" & Range("F6").Value & "<br><br>" & _
"Shop : " & Range("E8").Value & "<br>" & _
Range("E9").Value & "<br>" & _
Range("E10").Value & "<br>" & _
Range("E11").Value & "<br>" & .HTMLBody & "</font>"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Mail has been sent!"
Set OutApp = Nothing
'Set OutMail = Nothing End Sub
请帮助,谢谢
答案 0 :(得分:0)
扩展的.xlsx
和.xls
之间的差异可能是原因。
.xlsx
文件可以包含1 048 576
行,而.xls
文件只能包含65 536
行。
因此,VBA尝试将包含1 048 576
的整个工作表复制到只能处理.xls
行的65 536
工作簿中,并且会出现错误。
您可以决定将A1:A65536
本书中的具体范围.xlsx
复制到.xls
。
答案 1 :(得分:0)
我刚刚遇到了相同的错误消息。这似乎很罕见,因为我在网络上找不到其他提及。
该错误发生在我的一位客户的PC上,该客户使用我为他开发的VBA加载项。由于他在另一个国家,我无法直接调查。我建议他重新启动PC(完全重新启动,而不仅仅是关闭并启动),这似乎已经解决了。因此,显然这只是Excel中的一个临时故障。
答案 2 :(得分:0)
我遇到了这个错误,理查德指出,这种情况很少见。因此,我想分享我的解决方案。
出现此问题的一种情况是,如果您尝试在Excel中复制隐藏的工作表。要复制它,您需要先取消隐藏。