Can any one adjust the code pasted below so that when I run the macro it will automatically run in the code against the contents of the active workbook rather than opening a chosen file for it to run on?
I believe you will need to change the bit of code in BOLD
Dim original_wb As Workbook
Dim new_wb As Workbook
Set original_wb = Workbooks.Open("P:\Supplier Relations\Current Supplier Info\Database\Rob\member email addresses as of (26.05.2015).xlsm") 'adjust file location
row_count = original_wb.Sheets(1).UsedRange.Rows.Count
col_count = original_wb.Sheets(1).UsedRange.Columns.Count
For i = 2 To row_count Step 1
attachname = "THS_Direct_Trading_Terms_Contact_Details.xlsx"
emailaddress = original_wb.Sheets(1).Cells(i, 20).Value 'email address from column B
If emailaddress <> "" Then
Set new_wb = Workbooks.Add
original_wb.Sheets(1).Range("A" & i).EntireRow.Copy Destination:=new_wb.Sheets(1).Range("A2")
Application.DisplayAlerts = False
new_wb.SaveAs Environ("temp") & "\" & attachname
Set new_wb = Nothing
Application.DisplayAlerts = True
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
.To = emailaddress
.CC = ""
.BCC = ""
.Subject = "This is the Subject line" 'adjust subjectline!
.Body = "Dear Supplier," & vbCrLf & vbCrLf & "Attached are the terms/details we hold on file for your current trading terms and contact details with THS direct. Please can you confirm these details are correct by placing a 1 in cell Z3." & vbCrLf & "If there are any differences please overwrite the current terms in red font." & vbCrLf & "Once confirmed please return the complete spreadsheet to email@example.com" & vbCrLf & vbCrLf & "These terms will be incorporated into our THS Supplier Buying Agreement (SBA) which will subsequently be sent to yourselves to sign and return." & vbCrLf & vbCrLf & "Rob"
.Attachments.Add (Environ("temp") & "\" & attachname)
Set OutMail = Nothing
Set OutApp = Nothing
Kill Environ("temp") & "\" & attachname