Merging 2 VBA scripts

FlimbosQuest

New Member
Joined
Mar 14, 2008
Messages
2
Afternoon,

First off I will admit that I am a complete novice, so please forgive my ignorance/lack of knowledge.

I have 1 script that does exactly what I want, minus one thing which I have another script for....so here it goes.

Script 1 takes the email address from column B and sends an email to it if there is a 'Yes' in column C. After running the Macro, it will then put 'sent' in column D to prevent duplicate emails being sent to the same person if the Macro is run again. This is great, as it even allows me to add an attachment. The only problem is I also want it to include a signature from Outlook, which I have the code for, but have no idea on how to add that to script 1 so it does all of the above.


Here are the culprits.... :)


Script 1


Send_Email
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

On Error GoTo cleanup
For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" _
And LCase(cell.Offset(0, 2).Value) <> "sent" Then
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Test"
.Body = "Dear " & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & _
"Test test test test test test test test test test"
.Attachments.Add ("C:\scan0001.pdf")
.Send 'Or use Display
End With
On Error GoTo 0
cell.Offset(0, 2).Value = "sent"
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


Script 2


Email_with_sig
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strbody = "Testing" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\Mysig.txt"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next
With OutMail
.To = "flimbo@test.com"
.CC = ""
.BCC = ""
.Subject = "Test"
.Body = strbody & vbNewLine & vbNewLine & Signature
.Attachments.Add ("C:\test.txt")
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

For this one to work to work this function needs to be added too:

Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function


I hope this all makes sense and I'm also hoping someone will point me in the right direction, it would be much appreciated as I am pulling my hair out!!


Cheers,

Kim
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
try this
in macro script1 just after the line
Set OutApp = Nothing
type the line
script 2(EXACTLY as the second macro name)
 

Watch MrExcel Video

Forum statistics

Threads
1,122,511
Messages
5,596,576
Members
414,079
Latest member
Frills

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top