. Отправить для моего кода ниже vba, похоже, не работает - PullRequest
0 голосов
/ 28 мая 2020

Приведенный ниже код отлично работает только в этом. Отправить вызывает проблемы, я не знаю почему

   Sub Email_CurrentWorkBook()

Dim UserInputToEmail As String

'Не забудьте изменить идентификатор электронной почты перед запуском этого кода

    Dim OlApp As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim FileExt As String
    Dim TempFileName As String
    Dim FileFullPath As String
    Dim MyWb As Workbook


    Set MyWb = ThisWorkbook

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

TempFilePath = Environ $ ("temp") & "\"

    FileExt = "." & LCase(Right(MyWb.Name, Len(MyWb.Name) - InStrRev(MyWb.Name, ".", , 1)))
    TempFileName = MyWb.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss")
    FileFullPath = TempFilePath & TempFileName & FileExt
    MyWb.SaveCopyAs FileFullPath
    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)

    UserInputToEmail = Application.InputBox("Please enter an email address: ")

    With NewMail
        .To = UserInputToEmail
        .CC = ""
        .BCC = ""
        .Subject = "Automated file output"
        .Body = "Hello, Please find the attached your automated script output"
        .Attachments.Add FileFullPath '                                   

--- полный путь к временному файлу, в котором он сохранен. Dim T1 As Variant Dim T2 As Variant

    T1 = Now()
    T2 = DateAdd("s", 1, T1)

    Do Until T2 <= T1
    T1 = Now()
    Loop
    NewMail.Send
    .Send
    End With       
    On Error GoTo 0   
    Kill FileFullPath
    Set NewMail = Nothing
    Set OlApp = Nothing    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...