harky
07-16-2019, 10:02 PM
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*
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
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*
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