主题:【20pp醒目】vba高手帮我看看这段代码
认证会员
1143
438
| 引用： Sub SendActiveSheetWithOutlook() Dim WB1 As Workbook Dim WB2 As Workbook Dim WBname As String Application.ScreenUpdating = False Set WB1 = ActiveWorkbook WB1.ActiveSheet.Copy Set WB2 = ActiveWorkbook WB2.Activate WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" WB2.SaveAs Filename = "C:\" & WBname WB2.Close False Dim objOL As Object Dim itmNewMail As Object Set objOL = CreateObject("Outlook.Application") Set itmNewMail = objOL.CreateItem(olMailItem) With itmNewMail .To = "alexandkitty@gmail.com" .Attachments.Add "C:\" & WBname .Subject = "OUTLOOK 邮件示例, FM:" & Application.UserName .Send End With Kill "C:\" & WBname Set WB1 = Nothing Set WB2 = Nothing Set objOL = Nothing Set itmNewMail = Nothing Application.ScreenUpdating = True End Sub |
总是在刚刚开始运行的时候报错。
大家看看是什么问题，
第一个解决的兄弟，20pp马上奉上
[此贴子已经被作者于 2009-08-25 11:50:04 编辑过]
-------------------------------------------------------------------------------------------
I have defied Gods and Demons
http://s1.gladiatus.cn.com/game/c.php?uid=35379
http://s1.gladiatus.cn.com/game/c.php?uid=35379
发表于:2009-08-24 21:20:12
推荐：牙齿有问题，您找我!
...楼主...
Sub SendActiveSheetWithOutlook()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBname As String
Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook
WB1.ActiveSheet.Copy
Set WB2 = ActiveWorkbook
WB2.Activate
WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls"
WB2.SaveAs "C:/" & WBname
WB2.Close False
Dim objOL As Object
Dim itmNewMail As Object
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)
With itmNewMail
.To = "alexandkitty@gmail.com"
.Attachments.Add "C:/" & WBname
.Subject = "OUTLOOK 邮件示例, FM:" & Application.UserName
.Send
End With
Kill "C:/" & WBname
Set WB1 = Nothing
Set WB2 = Nothing
Set objOL = Nothing
Set itmNewMail = Nothing
Application.ScreenUpdating = True
End Sub
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBname As String
Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook
WB1.ActiveSheet.Copy
Set WB2 = ActiveWorkbook
WB2.Activate
WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls"
WB2.SaveAs "C:/" & WBname
WB2.Close False
Dim objOL As Object
Dim itmNewMail As Object
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)
With itmNewMail
.To = "alexandkitty@gmail.com"
.Attachments.Add "C:/" & WBname
.Subject = "OUTLOOK 邮件示例, FM:" & Application.UserName
.Send
End With
Kill "C:/" & WBname
Set WB1 = Nothing
Set WB2 = Nothing
Set objOL = Nothing
Set itmNewMail = Nothing
Application.ScreenUpdating = True
End Sub
-------------------------------------------------------------------------------------------
这个家伙很懒，什么也没留下......
发表于:2009-08-24 21:51:04
推荐：今天被亚新生活广场4楼上岛咖啡的托骗了600块
...第7楼...
回复主题 [ 返回宽带山KDS ]  |
|
|---|---|
| 主题： | 【20pp醒目】vba高手帮我看看这段代码 |
手机看宽带山
人像摄影推荐
