Send mail from Excel

Priyantha
2StarLounger
Posts: 102
Joined: 10 Oct 2022, 02:52

Send mail from Excel

Post by Priyantha »

Dear All,

I am using two macros to send Emails using an attachment with Gmail.
separately using, 01 for setting a password (PDF Attachment) 02. for sending emails. they work correctly while used separately. but I tried to combine them as one macro & while running it is displaying runtime error ** -2147024894 The System can't find file Specified**

My combined Code: Attached

the first part of the code is used to set a password for PDF File & second part is used to send mail with attachments. my file path is correct. Finally I tried removing the below code,

Attach_01 = "C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips" & em.Cells(j, "B").Value & ".pdf"

then was run the code & ware send maile without attachment.

please help me to solve this issue.

Priyantha
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Open Database From Excel - Only Local File Works - RESOLVED!

Post by HansV »

It would have been better to edit the subject and remove RESOLVED...
(This was before the posts were moved)
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Open Database From Excel - Only Local File Works - RESOLVED!

Post by HansV »

The line

Code: Select all

    Kill ("C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" & em.Cells(j, 2).Value & "*N.pdf")
should be moved to just above the line

Code: Select all

Next j
so that it is inside the loop.
Does that solve the problem?
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Send mail from Excel

Post by HansV »

I have moved the above three posts to a new thread, since they have nothing to do with the thread they were posted in.
Best wishes,
Hans

Priyantha
2StarLounger
Posts: 102
Joined: 10 Oct 2022, 02:52

Re: Send mail from Excel

Post by Priyantha »

Dear Hans,

I moved to just above the line Below the code but same error.

Kill ("C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" & em.Cells(j, 2).Value & "*N.pdf")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''Status'''''''''

If em.Cells(j, 7).Value = "" Then
em.Cells(j, 9).Value = " No Sent"

ElseIf em.Cells(j, 7).Value = 0 Then
em.Cells(j, 9).Value = " No Sent"

ElseIf AttachExists = "" Then
em.Cells(j, 9).Value = " No Sent"

Else

em.Cells(j, 9).Value = "Sent"

End If

Kill ("C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" & em.Cells(j, 2).Value & "*N.pdf") ,,,, Now

Application.Wait (Now + TimeValue("0:00:01"))

Next j

With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.DisplayStatusBar = False
End With

''Kill ("C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" & em.Cells(j, 2).Value & "*N.pdf") ----- Before

MsgBox "All email has been sent", vbInformation

NextID:

Exit_Err:
'Release object memory
Set NewMail = Nothing
Set mailConfig = Nothing
End

Err:
Select Case Err.Number
Case -2147220973 'Could be because of Internet Connection
MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
Case -2147220975 'Incorrect credentials User ID or password
MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
Case Else 'Report other errors
MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
End Select

Resume Exit_Err

End Sub

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Send mail from Excel

Post by HansV »

1) Move the first instance of that line to just above

Next j

as I wrote in my first reply.

2) Delete the second instance of that line.
Best wishes,
Hans

Priyantha
2StarLounger
Posts: 102
Joined: 10 Oct 2022, 02:52

Re: Send mail from Excel

Post by Priyantha »

Dear Hans,

I Tried as you said. but the same error.

Modified code attached here with.

thanks
Priyantha
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Send mail from Excel

Post by HansV »

Does the error occur on the line highlighted in yellow in your screenshot? That is different than the line you reported earlier.
It would indicate that the file you're trying to attach does not exist.
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Send mail from Excel

Post by HansV »

Does this work?

Code: Select all

Sub SendEmailUsingGmail_Welser()
    Const newPath = "C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\"

    Dim NewMail As Object, mailConfig As Object, fields As Variant, msConfigURL As String, last_row As Long
    Dim j As Long, Attach_01 As String, AttachExists_01 As String
    Dim em As Worksheet
    Dim Attach As String
    Dim AttachExists As String
    Dim filename_01 As String
    Dim retval As String
    Dim FileOrigine As String, FileDestinazione As String
    Dim MyPwd As String, strParam As String

    On Error GoTo Err:

    With Application
        .Calculation = xlCalculationManual
        .DisplayAlerts = True
        .DisplayStatusBar = True
    End With

    Set em = ThisWorkbook.Sheets("Email")
    last_row = em.Range("B" & em.Rows.Count).End(xlUp).Row

    For j = 4 To last_row
        filename_01 = em.Cells(j, 2).Value
        Attach = newPath & filename_01 & "*N.pdf"
        AttachExists = Dir(Attach)
        If AttachExists = "" Then
            em.Cells(j, 9).Value = " No Attachment"
            GoTo NextID
        ElseIf em.Cells(j, 7).Value = "" Then
            em.Cells(j, 9).Value = " No Email Address"
            GoTo NextID
        ElseIf em.Cells(j, 7).Value = 0 Then
            em.Cells(j, 9).Value = " No Email Address"
            GoTo NextID
        End If

        ''''' Set Password to PDF Files '''''''
        FileOrigine = newPath & filename_01 & "N.pdf"

        MyPwd = em.Cells(j, "H").Value
        FileDestinazione = newPath & filename_01 & ".pdf"

        FileOrigine = """" & FileOrigine & """"
        FileDestinazione = """" & FileDestinazione & """"
        MyPwd = """" & MyPwd & """"

        strParam = FileOrigine _
                 & " Output " & FileDestinazione _
                 & " User_pw " & MyPwd _
                 & " Allow AllFeatures"

        retval = Shell("C:\Program Files (x86)\PDFtk\bin\pdftk.exe " & strParam, 0) '<<=== Percorso da adattare N.B. lo spazio dopo pdftk.exe

        Attach_01 = newPath & filename_01 & ".pdf"
        AttachExists_01 = Dir(Attach_01)
        If AttachExists_01 = "" Then
            em.Cells(j, 9).Value = " Could Not Create Protected PDF"
            GoTo NextID
        End If

        Set NewMail = CreateObject("CDO.Message")
        Set mailConfig = CreateObject("CDO.Configuration")
        mailConfig.Load -1
        Set fields = mailConfig.fields
        'Set Email Properties
        With NewMail
            .From = "salary2.lvpp@gmail.com"
            .To = em.Cells(j, 7).Value
            .CC = ""
            .BCC = ""
            .Subject = "Salary Slip For the Month of   " & em.Range("D1").Value
            .TextBody = "Dear  " & em.Cells(j, 3).Value & "," & vbNewLine & vbNewLine & _
                "Please find your attached salary slip for the month of  " & _
                em.Range("D1").Value & "." & vbNewLine & vbNewLine & _
                "To open it, you are supposed to type your birth year and month without spaces as the password." & _
                vbNewLine & "(Ex: if your year of birth is 1985 and month is june, your password would be 198506)" & _
                vbNewLine & vbNewLine & "For any assistance, please contact 070-6702525 - Payroll Unit" & _
                vbNewLine & vbNewLine & "Best Regards," & vbNewLine & vbNewLine & "I.W. Karunarathna," & _
                vbNewLine & "Accountant (Payment & Payroll)," & vbNewLine & "Lakvijaya Power Station."
            .AddAttachment Attach_01
        End With

        msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

        With fields
            .Item(msConfigURL & "/smtpusessl") = True             'Enable SSL Authentication
            .Item(msConfigURL & "/smtpauthenticate") = 1          'SMTP authentication Enabled
            .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
            .Item(msConfigURL & "/smtpserverport") = 465          'Set the SMTP port Details
            .Item(msConfigURL & "/sendusing") = 2                 'Send using default setting
            .Item(msConfigURL & "/sendusername") = "salary.lvpp@gmail.com" 'Your gmail address
            .Item(msConfigURL & "/sendpassword") = "zolb xrkc cwko ones" 'Your password or App Password
            .Update                                               'Update the configuration fields
        End With

        NewMail.Configuration = mailConfig
       NewMail.Send

        '''' Status Bar'''''''
        Application.StatusBar = "Progress:  " & "PF No. : " & filename_01 & "   " & _
        j - 3 & " of " & last_row - 3 & "   : " & Format((j - 3) / (last_row - 3), "0%")

        Application.Wait Now + TimeValue("0:00:01")
        Kill newPath & em.Cells(j, 2).Value & "*N.pdf"
        em.Cells(j, 9).Value = "Sent"

NextID:
    Next j

    MsgBox "All email has been sent", vbInformation

Exit_Err:
    'Release object memory
    Set NewMail = Nothing
    Set mailConfig = Nothing

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .DisplayStatusBar = False
    End With
    Exit Sub

Err:
    Select Case Err.Number
        Case -2147220973  'Could be because of Internet Connection
            MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
        Case -2147220975  'Incorrect credentials User ID or password
            MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
        Case Else   'Report other errors
            MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select
    Resume Exit_Err
End Sub
Best wishes,
Hans

Priyantha
2StarLounger
Posts: 102
Joined: 10 Oct 2022, 02:52

Re: Send mail from Excel

Post by Priyantha »

Dear Hans,

Thanks, Your Code & try it. But I think, it is running up to below line only,
em.Cells(j, 9).Value = " Could Not Create Protected PDF"

All *.pdf files in "C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" have been protected with a password (without *.N.pdf files in that folder).


Thanks,

Priyantha
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Send mail from Excel

Post by HansV »

Apparently the line

Code: Select all

        retval = Shell("C:\Program Files (x86)\PDFtk\bin\pdftk.exe " & strParam, 0)
fails, but I cannot help you with that. I don't know anything about pdftk.exe.
Best wishes,
Hans

Priyantha
2StarLounger
Posts: 102
Joined: 10 Oct 2022, 02:52

Re: Send mail from Excel

Post by Priyantha »

Dear Hans,

Thanks for your Attention,

It's an app I found to protect pdf files with passwords. (Eg. Before Protect PW: 37224N.pdf, After protecting a password as 37224.pdf). All files are protected with a password, so I think it works correctly & protected files (eg. 37224.pdf) are in the folder ("C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\").

Something happened, When running the macro the first time, not sent any massage & in the folder ("C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\") appeared both types of files, with the protected files (Eg. 37224.pdf), and the initial case of files (eg. 37224N.pdf) appeared in the "C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" folder.

When running the macro the second time, all messages were sent correctly & Only protected files are found in the folder. what is happening?

Link For Protector With PW:
https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/


Priyantha

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Send mail from Excel

Post by HansV »

I'm sorry, I cannot help you with this.
Best wishes,
Hans

Priyantha
2StarLounger
Posts: 102
Joined: 10 Oct 2022, 02:52

Re: Send mail from Excel

Post by Priyantha »

Dear Hans,

OK Thanks

Priyantha
2StarLounger
Posts: 102
Joined: 10 Oct 2022, 02:52

Re: Send mail from Excel

Post by Priyantha »

Dear Hans,

I edit your code as below, then it is working, thanks your help again.

retval = Shell("C:\Program Files (x86)\PDFtk\bin\pdftk.exe " & strParam, 0) '<<=== Percorso da adattare N.B. lo spazio dopo pdftk.exe

Application.Wait Now + TimeValue("0:00:02")

Attach_01 = newPath & filename_01 & ".pdf"
AttachExists_01 = Dir(Attach_01)
If AttachExists_01 = "" Then
em.Cells(j, 9).Value = " Could Not Create Protected
PDF"
GoTo NextID
End If

Priyantha

User avatar
HansV
Administrator
Posts: 79030
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Send mail from Excel

Post by HansV »

Glad you found a solution!
Best wishes,
Hans