Электронная почта с Outlook, получение значений из открытой книги, из Excel - PullRequest
Новая
       8

Электронная почта с Outlook, получение значений из открытой книги, из Excel

0 голосов
/ 05 ноября 2018

Открыта моя рабочая книга "MASTER.xlsm". Я запускаю код из "MASTER.xlsm".

Я хочу получить значения из моего "MASTER.xlsm" во вновь созданную электронную почту Outlook. Я не получаю их там.

Что-то не так с последовательностью в коде? 

Sub EmailWithOutlook()
    Dim oApp As Object
    Dim oMail As Object
    Dim WB As Workbook
    Dim WBBW As Workbook
    Dim FileName As String
    Dim wSht As Worksheet
    Dim shtName As String
    Set WBBW = Workbooks("MASTER.xlsm")
    WBBW.Worksheets("MAIN").Range("D134").Value = variableX
    WBBW.Worksheets("MAIN").Range("D11").Value = variableY
    WBBW.Worksheets("MAIN").Range("D13").Value = variableZ

    Application.ScreenUpdating = False

    ' Make a copy of the active worksheet
    ' and save it to a temporary file
    ActiveSheet.Copy
    Set WB = ActiveWorkbook

    FileName = "My file"
    On Error Resume Next
    Kill "\" & FileName
    On Error GoTo 0
    WB.SaveAs FileName:=Environ$("temp") & "\" & FileName

    'Create and show the Outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        'Uncomment the line below to hard code a recipient
        .To = ""
        'Uncomment the line below to hard code a subject
        .Subject = "My subject | " & variableX & " | " & variableY
        'Uncomment the lines below to hard code a body
        .HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>Dear Sir/Madam, <br><br> please check this " & _
        variableZ & "" & _
        " and comment if needed.<br> Waiting for your reply ASAP. <br><br> Thank you!</BODY>" & .HTMLBody
        .Attachments.Add WB.FullName
        .Display
    End With

    'Delete the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False

    'Restore screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
End Sub

Ответы [ 2 ]

0 голосов
/ 08 ноября 2018

Вам не хватает Опция Явная 

Option Explicit

' Tools | Options | Editor tab
' Checkbox "Require Variable Declaration"

Sub EmailWithOutlook()

    Dim oApp As Object
    Dim oMail As Object

    Dim WB As Workbook
    Dim WBBW As Workbook

    Dim FileName As String

    Dim wSht As Worksheet
    Dim shtName As String

    Dim variableX As String
    Dim variableY As String
    Dim variableZ As String

    Set WBBW = Workbooks("MASTER.xlsm")

    variableX = "variableX string for example"
    variableY = "variableY string for example"
    variableZ = "variableZ string for example"

    WBBW.Worksheets("MAIN").Range("D134").Value = variableX
    WBBW.Worksheets("MAIN").Range("D11").Value = variableY
    WBBW.Worksheets("MAIN").Range("D13").Value = variableZ

    Application.ScreenUpdating = False

    ' Make a copy of the active worksheet
    ' and save it to a temporary file
    ActiveSheet.Copy
    Set WB = ActiveWorkbook

    FileName = "My file"
    On Error Resume Next
    ' This probably does not do anything. On Error Resume Next strikes again?
    Kill "\" & FileName
    On Error GoTo 0

    WB.SaveAs FileName:=Environ$("temp") & "\" & FileName

    'Create and show the Outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        'Uncomment the line below to hard code a recipient
        .To = ""
        'Uncomment the line below to hard code a subject
        .Subject = "My subject | " & variableX & " | " & variableY
        'Uncomment the lines below to hard code a body
        .HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>Dear Sir/Madam, <br><br> please check this " & _
        variableZ & "" & _
        " and comment if needed.<br> Waiting for your reply ASAP. <br><br> Thank you!</BODY>" & .HTMLBody
        .Attachments.Add WB.FullName
        .Display
    End With

    'Delete the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False

    'Restore screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
End Sub
0 голосов
/ 06 ноября 2018

Я проверил ваш код, как сказал Нитон, вы должны сначала объявить переменные, например. "variableX" "variableY" "variableZ". Однако, как я понимаю, вы просто хотите отправить электронное письмо из файла Excel. Таким образом, вы можете обратиться к следующему коду: 

Sub test()


Dim strReportName As String
Dim oLook As Object
Dim oMail As Object
Dim olns As Outlook.Namespace
Dim strTO As String
Dim strCC As String
Dim strMessageBody As String
Dim strSubject As String

Set oLook = CreateObject("Outlook.Application")
'Set olns = oLook.GetNamespace("MAPI")
Set oMail = oLook.CreateItem(0)

'*********************** USER DEFINED SECTION ************************
strTO = "chrissparkes@me.com"
strMessageBody = "<---This is an automatically generated email. Please do not respond.---->"
strSubject = "Daily Skip"
'*********************************************************************

With oMail
.To = strTO
 .CC = strCC
 .Body = strMessageBody
 .Subject = strSubject

 '.Attachments.Add "C:\Output Reports\SkipLotReport.xlsx"
 .Display
End With

Set oMail = Nothing
Set oLook = Nothing
'Set olns = Nothing


'DB.Close
'tbloutput.Close
'dbLocal.Close
objWorkbook.Close

'Set objmail = Nothing
'Set DB = Nothing
Set tbloutput = Nothing


Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
Set tbloutput = Nothing
Set dbLocal = Nothing
End Sub

Примечание. Пожалуйста, обратитесь к библиотеке Outlook.

Для получения дополнительной информации, пожалуйста, перейдите по ссылке: Отправка писем нескольким получателям с использованием VBA

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...