Excel VB Отправить активную книгу в формате PDF с помощью почты Zoho [CDO] - PullRequest
Новая
       39

Excel VB Отправить активную книгу в формате PDF с помощью почты Zoho [CDO]

0 голосов
/ 26 марта 2020

Прошло пару часов. Я не прикасался к vb с 10-го класса {2005} ... во всяком случае, Zoho {SUB of Google} Desktop Mail Client используется для отправки текущей активной книги в формате Excel в формате PDF. Мне пришлось написать это для работы, и я не нашел четкой информации, напрямую связанной с почтой Zoho, поэтому я поделюсь.

Если есть лучший способ или меньше строк кода и т. Д. c, пожалуйста, сообщите.

В настоящее время в коде будет отображаться всплывающее окно с сообщением «Почта отправлена», и он не будет открывать почтовый клиент Zoho.

Если есть способ, сообщите об этом. Я определенно хотел бы увидеть, как далеко я могу pu sh этот lol

быть нежным ко мне, плз хаха 

Sub SendPDF()
' Create PDF of active sheet and send as attachment.

 On Error GoTo Err


    Dim strPath As String, strFName As String
    Dim fields As Variant
    Dim msConfigURL As String
    Dim NewMail As Object
    Dim mailConfig As Object



' **************************************************************************************
'Create PDF of active sheet only
    strPath = Environ$("temp") & "\" 'Or any other path, but include trailing "\"

    strFName = ActiveWorkbook.Name
    strFName = Left(strFName, InStrRev(strFName, ".") - 1) & "_" & ActiveSheet.Name & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        strPath & strFName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

' **************************************************************************************

    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

' load all default configurations
    mailConfig.Load -1

    Set fields = mailConfig.fields

' **************************************************************************************

'Set All Email Properties
    On Error Resume Next

    With NewMail
        .From = "*******************"
        .To = "***************" 'Insert required address here ########
        .CC = ""
        .BCC = ""
        .Subject = "Test from YOU"
        .TextBody = "Test You are awesome!" & vbCr
        .AddAttachment strPath & strFName
        .Display   'Use only during debugging ##############################
        ' .Send      'Uncomment to send e-mail ##############################
    End With
' **************************************************************************************    
'Delete any temp files created
    Kill strPath & strFName
    On Error GoTo 0
' **************************************************************************************   
    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
' **************************************************************************************
    With fields
'Enable SSL Authentication
        .Item(msConfigURL & "/smtpusessl") = True

'Make SMTP authentication Enabled=true (1)
        .Item(msConfigURL & "/smtpauthenticate") = 1

'Set the SMTP server and port Details
'To get these details you can get on Settings Page of your Zoho Account
        .Item(msConfigURL & "/smtpserver") = "smtp.zoho.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2

'Set your credentials of your Zoho Account
        .Item(msConfigURL & "/sendusername") = "***********"
        .Item(msConfigURL & "/sendpassword") = "***********"

'Update the configuration fields
        .Update

    End With
    NewMail.Configuration = mailConfig
    NewMail.Send
    MsgBox ("Mail has been Sent")

' **************************************************************************************

Exit_Err:

    Set NewMail = Nothing
    Set mailConfig = Nothing
    End
' **************************************************************************************

Err:
    Select Case Err.Number

    Case -2147220973  'Could be because of Internet Connection
        MsgBox " Could be no Internet Connection !!  -- " & Err.Description

    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Incorrect Credentials !!  -- " & Err.Description

    Case Else   'Rest other errors
        MsgBox "Error occured while sending the email !!  -- " & Err.Description
    End Select

    Resume Exit_Err

End Sub
...