VBA to send emails attachment base on path (folder)
Page 3 of 4 FirstFirst 1234 LastLast
Results 21 to 30 of 39

Thread: VBA to send emails attachment base on path (folder)

  1. #21
    Board Regular
    Join Date
    Apr 2010
    Location
    Singapore
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    yes this one..! thank u so much!!! !!

    Quote Originally Posted by DanteAmor View Post
    Try this

    In H put the folder and the pattern
    Examples:

    C:\Users\ABC\Desktop\SavedFolder\Email1\test.JPG
    C:\Users\ABC\Desktop\SavedFolder\Email1\*.pdf
    C:\Users\ABC\Desktop\SavedFolder\Email1\*



    Code:
    Sub SendEmail()
        Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long, d As Long
        Dim wks As Worksheet, pf As String, wPath As String, wFile As Variant, wPattern As String
    
    
        'START of confirmation message box'
        response = MsgBox("Start sending email?", vbYesNo)
        If response = vbNo Then
            MsgBox ("Macro Canceled!")
            Exit Sub
        End If
        'END of confirmation message box'
        Set Mail_Object = CreateObject("Outlook.Application")
        Set wks = Worksheets("send_email")
        lr = wks.Cells(Rows.Count, "B").End(xlUp).Row
        For i = 2 To lr
            With Mail_Object.CreateItem(o)
                .to = wks.Range("B" & i).Value
                .cc = wks.Range("C" & i).Value
                .Subject = wks.Range("D" & i).Value
                .Body = wks.Range("E" & i).Value & vbNewLine & _
                    wks.Range("F" & i).Value & vbNewLine & _
                    wks.Range("G" & i).Value
                 
                pf = wks.Range("H" & i).Value
                d = InStrRev(pf, "\")
                wPath = Left(pf, d)
                wPattern = Mid(pf, d + 1)
                If wPattern = "" Then wPattern = "*.*"
                'If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
                If Dir(wPath, vbDirectory) <> "" Then
                    wFile = Dir(wPath & wPattern)
                    On Error Resume Next
                    Do While wFile <> ""
                        'If Dir(wPath & wFile) <> "" Then
                            .Attachments.Add wPath & wFile
                        'End If
                        wFile = Dir()
                    Loop
                    On Error GoTo 0
                End If
                '.Send
                .display 'disable display and enable send to send automatically
                Application.Wait (Now + TimeValue("0:00:03")) 'Pausing an application for 3s, before next email
            End With
        Next i
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
        Set Mail_Object = Nothing
    End Sub
    Now, you already have 2 versions, in a column and in 2 columns.

  2. #22
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,751
    Post Thanks / Like
    Mentioned
    65 Post(s)
    Tagged
    14 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    Quote Originally Posted by harky View Post
    yes this one..! thank u so much!!! !!
    I'm glad to help you. Thanks for the feedback.
    Regards Dante Amor

  3. #23
    Board Regular
    Join Date
    Apr 2010
    Location
    Singapore
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    Hi,
    After doing more testing.. I tot if possible to enhance more?

    Add a Status Update at Column I for .sent mode.

    Function like MACRO can check the max attached that serve allow.

    And Status able to put remarks:
    IF email; found exceed server attached size, it will ABORT action. Then status will update with remark: exceed server size at Column I and process the next row email.
    IF email; found wrong file URL, it will ABORT action. Than status will update with remark: wrong file path at Column I and process the next row email.
    IF email; found wrong folder URL, it will ABORT action. Than status will update with remark: wrong folder path at Column I and process the next row email.
    IF email no error found; it will send email and update status with remark: email send! at Column I and process the next email.

    Code:
    Remark at Col I
    Value = "Attach exceed server size" 'attached files exceed server size <-- can put colour in red?
    Value = "wrong file path " 'Path file wrong <-- can put colour in red?
    Value = "wrong folder path " 'Path folder wrong <-- can put colour in red?
    "email send!" 'successful send email
    wonder, if tht possible? :/


    Quote Originally Posted by DanteAmor View Post
    I'm glad to help you. Thanks for the feedback.
    Last edited by harky; Jul 19th, 2019 at 10:44 AM.

  4. #24
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,751
    Post Thanks / Like
    Mentioned
    65 Post(s)
    Tagged
    14 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    Quote Originally Posted by harky View Post
    Hi,
    After doing more testing.. I tot if possible to enhance more?

    Add a Status Update at Column I for .sent mode.

    Function like MACRO can check the max attached that serve allow.

    And Status able to put remarks:
    IF email; found exceed server attached size, it will ABORT action. Then status will update with remark: exceed server size at Column I and process the next row email.
    IF email; found wrong file URL, it will ABORT action. Than status will update with remark: wrong file path at Column I and process the next row email.
    IF email; found wrong folder URL, it will ABORT action. Than status will update with remark: wrong folder path at Column I and process the next row email.
    IF email no error found; it will send email and update status with remark: email send! at Column I and process the next email.

    Code:
    Remark at Col I
    Value = "Attach exceed server size" 'attached files exceed server size <-- can put colour in red?
    Value = "wrong file path " 'Path file wrong <-- can put colour in red?
    Value = "wrong folder path " 'Path folder wrong <-- can put colour in red?
    "email send!" 'successful send email
    wonder, if tht possible? :/

    just some cases, try this
    Code:
    Sub SendEmail()
        Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long, d As Long
        Dim wks As Worksheet, pf As String, wPath As String, wFile As Variant, wPattern As String
        Dim num_err As Variant, sErr As Boolean
    
    
        'START of confirmation message box'
        response = MsgBox("Start sending email?", vbYesNo)
        If response = vbNo Then
            MsgBox ("Macro Canceled!")
            Exit Sub
        End If
        'END of confirmation message box'
        Set Mail_Object = CreateObject("Outlook.Application")
        Set wks = Worksheets("send_email")
        lr = wks.Cells(Rows.Count, "B").End(xlUp).Row
        For i = 2 To lr
            sErr = False
            With Mail_Object.CreateItem(o)
                .to = wks.Range("B" & i).Value
                .cc = wks.Range("C" & i).Value
                .Subject = wks.Range("D" & i).Value
                .Body = wks.Range("E" & i).Value & vbNewLine & _
                    wks.Range("F" & i).Value & vbNewLine & _
                    wks.Range("G" & i).Value
                 
                pf = wks.Range("H" & i).Value
                d = InStrRev(pf, "\")
                wPath = Left(pf, d)
                wPattern = Mid(pf, d + 1)
                If wPattern = "" Then wPattern = "*.*"
                'If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
                If Dir(wPath, vbDirectory) <> "" Then
                    wFile = Dir(wPath & wPattern)
                    On Error Resume Next
                    If wFile <> "" Then
                        Do While wFile <> ""
                            .Attachments.Add wPath & wFile
                            num_error = Err.Number
                            If num_error <> 0 Then
                                wks.Range("I" & i).Value = "No file Attach"
                                sErr = True
                            End If
                            wFile = Dir()
                        Loop
                    Else
                        wks.Range("I" & i).Value = "wrong file"
                        sErr = True
                    End If
                    On Error GoTo 0
                Else
                    wks.Range("I" & i).Value = "wrong file path"
                    sErr = True
                End If
                If sErr = False Then
                    .Send
                    '.display 'disable display and enable send to send automatically
                    num_error = Err.Number
                    If num_error <> 0 Then
                        wks.Range("I" & i).Value = Err.Description
                    Else
                        wks.Range("I" & i).Value = "email send"
                    End If
                End If
                'Application.Wait (Now + TimeValue("0:00:03")) 'Pausing an application for 3s, before next email
            End With
        Next i
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
        Set Mail_Object = Nothing
    End Sub
    Regards Dante Amor

  5. #25
    Board Regular
    Join Date
    Apr 2010
    Location
    Singapore
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    i had an error say
    outlook does not recognize one or more names.
    debug = .sent

    EDIT: SOrr is my mistake, at the email. (Wrong address)

    Quote Originally Posted by DanteAmor View Post
    just some cases, try this
    Code:
    Sub SendEmail()
        Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long, d As Long
        Dim wks As Worksheet, pf As String, wPath As String, wFile As Variant, wPattern As String
        Dim num_err As Variant, sErr As Boolean
    
    
        'START of confirmation message box'
        response = MsgBox("Start sending email?", vbYesNo)
        If response = vbNo Then
            MsgBox ("Macro Canceled!")
            Exit Sub
        End If
        'END of confirmation message box'
        Set Mail_Object = CreateObject("Outlook.Application")
        Set wks = Worksheets("send_email")
        lr = wks.Cells(Rows.Count, "B").End(xlUp).Row
        For i = 2 To lr
            sErr = False
            With Mail_Object.CreateItem(o)
                .to = wks.Range("B" & i).Value
                .cc = wks.Range("C" & i).Value
                .Subject = wks.Range("D" & i).Value
                .Body = wks.Range("E" & i).Value & vbNewLine & _
                    wks.Range("F" & i).Value & vbNewLine & _
                    wks.Range("G" & i).Value
                 
                pf = wks.Range("H" & i).Value
                d = InStrRev(pf, "\")
                wPath = Left(pf, d)
                wPattern = Mid(pf, d + 1)
                If wPattern = "" Then wPattern = "*.*"
                'If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
                If Dir(wPath, vbDirectory) <> "" Then
                    wFile = Dir(wPath & wPattern)
                    On Error Resume Next
                    If wFile <> "" Then
                        Do While wFile <> ""
                            .Attachments.Add wPath & wFile
                            num_error = Err.Number
                            If num_error <> 0 Then
                                wks.Range("I" & i).Value = "No file Attach"
                                sErr = True
                            End If
                            wFile = Dir()
                        Loop
                    Else
                        wks.Range("I" & i).Value = "wrong file"
                        sErr = True
                    End If
                    On Error GoTo 0
                Else
                    wks.Range("I" & i).Value = "wrong file path"
                    sErr = True
                End If
                If sErr = False Then
                    .Send
                    '.display 'disable display and enable send to send automatically
                    num_error = Err.Number
                    If num_error <> 0 Then
                        wks.Range("I" & i).Value = Err.Description
                    Else
                        wks.Range("I" & i).Value = "email send"
                    End If
                End If
                'Application.Wait (Now + TimeValue("0:00:03")) 'Pausing an application for 3s, before next email
            End With
        Next i
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
        Set Mail_Object = Nothing
    End Sub
    Last edited by harky; Jul 19th, 2019 at 01:01 PM.

  6. #26
    Board Regular
    Join Date
    Apr 2010
    Location
    Singapore
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    Hi, i tested..

    The action will ABORT if
    exceed server attached size;
    wrong file;
    Wrong Folder;

    tot need to put FileExists check if a file exists?

    I try to put a folder tht has 133MB but msg come out is No file Attach?
    If never put URL, it also No file Attach? If put never link should state email send

    suppose to be exceed server attached size

    I mean the msg is abit confuse.

    Quote Originally Posted by DanteAmor View Post
    just some cases, try this
    Code:
    Sub SendEmail()
        Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long, d As Long
        Dim wks As Worksheet, pf As String, wPath As String, wFile As Variant, wPattern As String
        Dim num_err As Variant, sErr As Boolean
    
    
        'START of confirmation message box'
        response = MsgBox("Start sending email?", vbYesNo)
        If response = vbNo Then
            MsgBox ("Macro Canceled!")
            Exit Sub
        End If
        'END of confirmation message box'
        Set Mail_Object = CreateObject("Outlook.Application")
        Set wks = Worksheets("send_email")
        lr = wks.Cells(Rows.Count, "B").End(xlUp).Row
        For i = 2 To lr
            sErr = False
            With Mail_Object.CreateItem(o)
                .to = wks.Range("B" & i).Value
                .cc = wks.Range("C" & i).Value
                .Subject = wks.Range("D" & i).Value
                .Body = wks.Range("E" & i).Value & vbNewLine & _
                    wks.Range("F" & i).Value & vbNewLine & _
                    wks.Range("G" & i).Value
                 
                pf = wks.Range("H" & i).Value
                d = InStrRev(pf, "\")
                wPath = Left(pf, d)
                wPattern = Mid(pf, d + 1)
                If wPattern = "" Then wPattern = "*.*"
                'If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
                If Dir(wPath, vbDirectory) <> "" Then
                    wFile = Dir(wPath & wPattern)
                    On Error Resume Next
                    If wFile <> "" Then
                        Do While wFile <> ""
                            .Attachments.Add wPath & wFile
                            num_error = Err.Number
                            If num_error <> 0 Then
                                wks.Range("I" & i).Value = "No file Attach"
                                sErr = True
                            End If
                            wFile = Dir()
                        Loop
                    Else
                        wks.Range("I" & i).Value = "wrong file"
                        sErr = True
                    End If
                    On Error GoTo 0
                Else
                    wks.Range("I" & i).Value = "wrong file path"
                    sErr = True
                End If
                If sErr = False Then
                    .Send
                    '.display 'disable display and enable send to send automatically
                    num_error = Err.Number
                    If num_error <> 0 Then
                        wks.Range("I" & i).Value = Err.Description
                    Else
                        wks.Range("I" & i).Value = "email send"
                    End If
                End If
                'Application.Wait (Now + TimeValue("0:00:03")) 'Pausing an application for 3s, before next email
            End With
        Next i
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
        Set Mail_Object = Nothing
    End Sub

    Last edited by harky; Jul 19th, 2019 at 01:23 PM.

  7. #27
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,751
    Post Thanks / Like
    Mentioned
    65 Post(s)
    Tagged
    14 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    Quote Originally Posted by harky View Post
    Hi, i tested..

    The action will ABORT if
    exceed server attached size;
    wrong file;
    Wrong Folder;

    tot need to put FileExists check if a file exists?

    I try to put a folder tht has 133MB but msg come out is No file Attach?
    If never put URL, it also No file Attach? If put never link should state email send

    suppose to be exceed server attached size

    I mean the msg is abit confuse.
    I can not control all possible error messages that may exist, so I commented "just some cases".
    Regards Dante Amor

  8. #28
    Board Regular
    Join Date
    Apr 2010
    Location
    Singapore
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    ehh, than nvm because i try other.. there is an error where it show exceed server attached size

    But than how come
    If never put URL, it also No file Attach?
    i tot, it suppose to email send/?


    Quote Originally Posted by DanteAmor View Post
    I can not control all possible error messages that may exist, so I commented "just some cases".
    Last edited by harky; Jul 19th, 2019 at 02:17 PM.

  9. #29
    Board Regular
    Join Date
    Apr 2010
    Location
    Singapore
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    The code is ok

    But, i cant send out email without putting any URL
    can tht be fix?

    Quote Originally Posted by DanteAmor View Post
    I can not control all possible error messages that may exist, so I commented "just some cases".

  10. #30
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,751
    Post Thanks / Like
    Mentioned
    65 Post(s)
    Tagged
    14 Thread(s)

    Default Re: VBA to send emails attachment base on path (folder)

    Quote Originally Posted by harky View Post
    The code is ok

    But, i cant send out email without putting any URL
    can tht be fix?

    What do you mean?
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •