View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ron de Bruin Ron de Bruin is offline
external usenet poster
 
Posts: 11,123
Default need help to create multiple copies of sheet for different sales reps

Here is a tester that display the mails with the attachment

Change this

Set DataSheet = Sheets("Sheet1")
Set InfoSheet = Sheets("SalesCode")

Sheet1 is the template with cell D1 as your input cell

'D1 is the Sales code cell
DataSheet.Range("D1").Value = cell.Value


In Sheets("SalesCode") in A1:A60 the sales codes and in column B the E-Mail addresses



Sub test()
Dim OutApp As Object
Dim OutMail As Object
Dim wb As Workbook
Dim DataSheet As Worksheet
Dim InfoSheet As Worksheet
Dim cell As Range
Dim strdate As String

strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False

Set DataSheet = Sheets("Sheet1")
Set InfoSheet = Sheets("SalesCode")

For Each cell In InfoSheet.Range("A1:A60")
If cell.Offset(0, 1).Value Like "?*@?*.?*" Then

'D1 is the Sales code cell
DataSheet.Range("D1").Value = cell.Value
DataSheet.Copy

Set wb = ActiveWorkbook
With wb
.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Offset(0, 1).Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add wb.FullName
.Display 'or use .Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With

Set OutMail = Nothing
Set OutApp = Nothing
End If
Next cell
Application.ScreenUpdating = True

End Sub




--
Regards Ron de Bruin
http://www.rondebruin.nl


"mdias815" wrote in message
...

I am going to send as an attachment using Outlook


--
mdias815
------------------------------------------------------------------------
mdias815's Profile: http://www.excelforum.com/member.php...o&userid=31509
View this thread: http://www.excelforum.com/showthread...hreadid=511863