VBA Help: Email attachment via folder or direct-link

Hi, I need someone help.
I dont know any vb code. Possible if someone could help me merge this code into 1 (highlighted in red)?

This is how the idea is.
Col H will use/check either Folder or Direct Full link

IF Folder path found, it will attach all files from the folder
IF direct-link found, it will attach the file
IF no link found, it will just send email as normal

A	B	C	D	E	F	G	H
S/N	TO	CC	Subject	Greeting	Body Text	Signature	Path of Attachment folder / Direct Link
1							C:\Users\ABC\Desktop\SavedFolder\Folder1\ *all attach all files found in folder
2							C:\Users\ABC\Desktop\SavedFolder\Folder2\abc.pdf * or direct path - can be jpg, pdf, zip, doc*

Code:

---


Sub SendEmail3()
    Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
    Dim wks As Worksheet, wPath As String, wFile As Variant

    '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'
   
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    Set Mail_Object = CreateObject("Outlook.Application")
    Set wks = Worksheets("SendEmail_MOD2")  'worksheet name
    For i = 2 To lr
        With Mail_Object.CreateItem(o)
            .To = wks.Range("B" & i).Value
            .CC = wks.Range("C" & i).Value
            '.BCC = wks.Range("G" & I).Value    'G is refer to column G in excel
            .Subject = wks.Range("D" & i).Value
           
            .Body = wks.Range("E" & i).Value & vbNewLine & _
            wks.Range("F" & i).Value & vbNewLine & _
            wks.Range("G" & i).Value
           
            If wks.Range("I" & i).Value <> "" Then
            .Attachments.Add Range("I" & i).Value
          End If
         
            wPath = wks.Range("H" & i).Value
            If Right(wPath, 1) <> "" Then wPath = wPath & ""
            If Dir(wPath, vbDirectory) <> "" Then
                wFile = Dir(wPath & "*.*")
                Do While wFile <> ""
                    .Attachments.Add wPath & wFile
                    wFile = Dir()
                Loop
            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

---

The following will do what you asked

Code:

---

Option Explicit

Sub SendEmail4()
'Graham Mayor - https://www.gmayor.com - Last updated - 17 Jul 2019
Dim i As Integer
Dim olApp As Object
Dim olMailItem As Object
Dim lngLastRow As Long
Dim wks As Worksheet
Dim strPath As String
Dim strFile As String
Dim lngResponse As Long
Dim oFSO As Object


    'START of confirmation message box'
    lngResponse = MsgBox("Start sending email?", vbYesNo)
    If lngResponse = vbNo Then
        MsgBox ("Macro Canceled!")
        Exit Sub
    End If
    'END of confirmation message box'


    Set oFSO = CreateObject("Scripting.FileSystemObject")


    Set olApp = CreateObject("Outlook.Application")
    Set wks = Worksheets("SendEmail_MOD2")  'worksheet name
    lngLastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row
    For i = 2 To lngLastRow
        Set olMailItem = olApp.createitem(0)
        With olMailItem
            .To = wks.Range("B" & i).value
            .CC = wks.Range("C" & i).value
            '.BCC = wks.Range("G" & I).Value    'G is refer to column G in excel
            .display    'disable display and enable send to send automatically


            .Subject = wks.Range("D" & i).value


            .Body = wks.Range("E" & i).value & vbNewLine & _
                    wks.Range("F" & i).value & vbNewLine & _
                    wks.Range("G" & i).value


            If wks.Range("I" & i).value <> "" Then
                .Attachments.Add Range("I" & i).value
            End If


            strPath = wks.Range("H" & i).value
            If Right(strPath, 1) = Chr(92) Then    'value is a folder
                If Dir(strPath, vbDirectory) <> "" Then
                    strFile = Dir(strPath & "*.*")
                    Do While strFile <> ""
                        .Attachments.Add strPath & strFile, , 1
                        strFile = Dir()
                    Loop
                End If
            Else
                If oFSO.FileExists(strPath) Then
                    .Attachments.Add strPath, , 1
                End If
            End If


            '.Send
            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 olApp = Nothing
    Set olMailItem = Nothing
    Set oFSO = Nothing
    Set wks = Nothing
End Sub

---

omg! It work great and i notice it actually check the attached files size too.

Ehhh can i had a request? : pray2:

I like to put status at Col I

This below is for .send (mode), as i got alot of email to send. So it better not to use .display as it will had many pop-up or abort

if email
exceed server size, it will ABORT SEND EMAIL than state (remark: exceed server size) at Col I and process the next email.
wrong file path, , it will ABORT SEND EMAIL than state (remark: wrong file path) at Col I and process the next email.
wrong folder path, , it will ABORT SEND EMAIL than state (remark: wrong folder path) at Col I and process the next email.
email send, than state (remark: email send!) at Col I and process the next email.

email send mean
- server size ok or
- files path ok or
- folder path ok or
- no link found at Col H

Code:

---

Remark at Col I
Offset(, 8).Value = "exceed server size" 'attached files exceed server size <-- can put colour in red?
Offset(, 8).Value = "wrong file path " 'Path file wrong <-- can put colour in red?
Offset(, 8).Value = "wrong folder path " 'Path folder wrong <-- can put colour in red?
Offset(, 8).Value = "email send!" 'successful send email

---

Quote:

---

Originally Posted by gmayor

The following will do what you asked

Code:

---

Option Explicit

Sub SendEmail4()
'Graham Mayor - https://www.gmayor.com - Last updated - 17 Jul 2019
Dim i As Integer
Dim olApp As Object
Dim olMailItem As Object
Dim lngLastRow As Long
Dim wks As Worksheet
Dim strPath As String
Dim strFile As String
Dim lngResponse As Long
Dim oFSO As Object


    'START of confirmation message box'
    lngResponse = MsgBox("Start sending email?", vbYesNo)
    If lngResponse = vbNo Then
        MsgBox ("Macro Canceled!")
        Exit Sub
    End If
    'END of confirmation message box'


    Set oFSO = CreateObject("Scripting.FileSystemObject")


    Set olApp = CreateObject("Outlook.Application")
    Set wks = Worksheets("SendEmail_MOD2")  'worksheet name
    lngLastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row
    For i = 2 To lngLastRow
        Set olMailItem = olApp.createitem(0)
        With olMailItem
            .To = wks.Range("B" & i).value
            .CC = wks.Range("C" & i).value
            '.BCC = wks.Range("G" & I).Value    'G is refer to column G in excel
            .display    'disable display and enable send to send automatically


            .Subject = wks.Range("D" & i).value


            .Body = wks.Range("E" & i).value & vbNewLine & _
                    wks.Range("F" & i).value & vbNewLine & _
                    wks.Range("G" & i).value


            If wks.Range("I" & i).value <> "" Then
                .Attachments.Add Range("I" & i).value
            End If


            strPath = wks.Range("H" & i).value
            If Right(strPath, 1) = Chr(92) Then    'value is a folder
                If Dir(strPath, vbDirectory) <> "" Then
                    strFile = Dir(strPath & "*.*")
                    Do While strFile <> ""
                        .Attachments.Add strPath & strFile, , 1
                        strFile = Dir()
                    Loop
                End If
            Else
                If oFSO.FileExists(strPath) Then
                    .Attachments.Add strPath, , 1
                End If
            End If


            '.Send
            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 olApp = Nothing
    Set olMailItem = Nothing
    Set oFSO = Nothing
    Set wks = Nothing
End Sub

---

---

hi, my request had been solved. Thanks