Отправка писем из Excel-я через Outlook - VBA

Узнай цену своей работы

Формулировка задачи:

Всем доброго времени суток. Очень большая просьба помочь доделать. Есть макрос для отправки писем из икселя через оутлук с вложением текущего файла. Возможно ли внести исправление, чтобы не вкладывался файл, а из него в тело письма вставлялись только выделенные ячейки?
Листинг программы
  1. Sub Send_Mail()
  2. Dim objOutlookApp As Object, objMail As Object
  3. Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
  4. Dim sCc As String
  5. Application.ScreenUpdating = False
  6. On Error Resume Next
  7. Set objOutlookApp = CreateObject("Outlook.Application")
  8. objOutlookApp.Session.Logon
  9. Set objMail = objOutlookApp.CreateItem(0)
  10. If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
  11. sTo = "***@***.ru"
  12. sCc = "***@***.ru "
  13. sSubject = "отчет"
  14. sBody = "Добрый день," & "<BR>" & "Отчётные данные:"
  15. (вставка из таблицы)
  16. With objMail
  17. .To = sTo
  18. .Cc = sCc
  19. .Subject = sSubject
  20. .HTMLBody = sBody
  21. .Display End With
  22. exit_:
  23. Set objOutlookApp = Nothing: Set objMail = Nothing
  24. Application.ScreenUpdating = True
  25. End Sub
Всем заранее спасибо!

Решение задачи: «Отправка писем из Excel-я через Outlook»

textual
Листинг программы
  1. #If VBA7 Then
  2.     #If Win64 Then
  3.         Private Declare PtrSafe Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As LongPtr) As LongPtr
  4.     #Else
  5.         Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As LongPtr) As LongPtr
  6.     #End If
  7. #Else
  8.     #If Win64 Then
  9.         Private Declare PtrSafe Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As LongLong) As LongLong
  10.     #Else
  11.         Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
  12.     #End If
  13. #End If
  14.  
  15. Sub aaaa11111Send_Mail()
  16. Dim objOutlookApp As Object, objMail As Object
  17. Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
  18. Dim sCc As String
  19. Application.ScreenUpdating = False
  20. Dim wbkX As Workbook
  21.     Dim shtX As Worksheet
  22.     Dim rngBody As Range
  23.     Dim rngCell As Range
  24.     On Error Resume Next
  25.     LoadKeyboardLayout "0000419", &H1
  26.      Set wbkX = ActiveWorkbook
  27.     Set shtX = wbkX.Sheets(1)
  28.     wbkX.Activate
  29.     Set rngBody = Selection
  30.     Selection.Copy
  31.     Set objOutlookApp = CreateObject("Outlook.Application")
  32. objOutlookApp.Session.Logon
  33. Set objMail = objOutlookApp.CreateItem(0)
  34. If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
  35.  sTo = "***@***.ru"
  36. sCc = "***@***.ru"
  37. sSubject = "отчет"
  38. sBody = "Добрый день," & "<BR>" & "Отчётные данные:"
  39. With objMail
  40. .To = sTo
  41. .CC = sCc
  42. .Subject = sSubject
  43. .HTMLBody = sBody
  44. .Display
  45. SendKeys ("^{END}")
  46. SendKeys ("{ENTER}{ENTER}")
  47. 'SendKeys ("~ ~")
  48. SendKeys "^v", True
  49.  End With
  50. exit_:
  51. Set objOutlookApp = Nothing: Set objMail = Nothing
  52. Application.ScreenUpdating = True
  53. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

6   голосов , оценка 3.5 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут