отправка листа по элетропочте

[vadimo]

комрадс, нид хелп!
задача:
из существующей excel-книги отправить по почте определенный лист как вложение.
т.е. как я понимаю, надоть создать пустую книгу, в нее вставить этот лист, книгу сохранить как-то и отправить эту книгу аттачментом. неполучается чото у меня... (кстати, возможно я усложнил алгоритм, поправьте плиз)

Sub Send()

With Workbooks("vibrators.xls").Worksheets("Изменения")
.Sheets(9).Copy

' не знаю как переключиться на книгу, которую excel создал
' командой .sheets().copy, положив в нее этот лист.
' и проперти destination - какая-то лажа, не знаю как его
' присунуть


' .SendMail Recipients:="pupkin@pupkins.cn", Subject:="Изменения " & Format (Date, "dd/mmm/yy")
.Close SaveChanges:=False
End With
End Sub

[yura613]

Sub PISMOOTPRAVKA()
Dim a As String
Dim DestWB As Workbook
Dim ws As Object


Application.ScreenUpdating = False
Set DestWB = Workbooks.Add(xlWorksheet)



a = "\\prm-f1\homes\bja\My Documents\документы\НМА\Данные\Продо\YURA.xls"
' здесь путь к файлу из которго хочешь скопировать страницу



Dim OrigWB As Workbook
Set OrigWB = Workbooks.Open(Filename:=a, ReadOnly:=True)

OrigWB.Worksheets(1).Copy after:=DestWB.Sheets(DestWB.Sheets.Count)
'здесь Worksheets( ) поставь номер страницы или имя страницы в кавычках

OrigWB.Close Savechanges:=False


Application.DisplayAlerts = False
DestWB.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

DestWB.SendMail Recipients:="aaaa@ru"
'напиши тут свой адрес


DestWB.Close Savechanges:=False
Set DestWB = Nothing

End Sub

проверено работает

[vadimo]

угу, работает! мерси большое.

[yura613]

Вот тебе еще вариант почти тоже самое только можно отправлять из исходного файла, не создавая пустой файл

Код: Выделить всё

Sub PISMOOTPRAVKA2()
Dim a As String
Dim DestWB As Workbook
Dim ws As Object

Dim OrigWB As Workbook
Set OrigWB = ActiveWorkbook


Application.ScreenUpdating = False
Set DestWB = Workbooks.Add(xlWorksheet)



a = "\\prm-f1\homes\bja\My Documents\документы\НМА\Данные\Продо\YURA.xls"
' здесь путь к файлу из которго хочешь скопировать страницу





OrigWB.Worksheets(1).Copy after:=DestWB.Sheets(DestWB.Sheets.Count)
'здесь Worksheets( ) поставь номер страницы или имя страницы в кавычках

'OrigWB.Close Savechanges:=False


Application.DisplayAlerts = False
DestWB.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

DestWB.SendMail Recipients:="ееее@by"
'напиши тут свой адрес


'DestWB.Close Savechanges:=False ' здесь еще можешь вызвать какое нибудь диалоговое окно для сохранения
Set DestWB = Nothing

End Sub