View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Living the Dream Living the Dream is offline
external usenet poster
 
Posts: 151
Default Concatenate cells with line breaks in them

Hi

This is the pre-structured email I send out.

Hi,

Please be advised that We will be picking up the following Order(s) :

Vendor : Your Company Name
Load ID : 9876543
PO No(s) : 1234567
Pallet Stack(s) : 22

Bound For : Your Destination

Day : Friday
Date : 18/01/2013
Time : 08:00 Approx

NOTE:
We strive to meet all expected Pick up Arrival times provided although
infrequent events and circumstance outside our control may affect the
Pick up Time

Should you have any issues or concerns on the morning of the pick up
please contact the Fleet Controller
( As early as possible to avoid potential inconveniences ).

Regards,
Transport

This is the I use which you will have to modify it to suit your needs

HTH\
Mick.

Sub sendEmails()

Dim emailaddr As String
Dim cLoad As String
Dim cPO As String
Dim cDay As String
Dim cDat As String
Dim CTime As String
Dim cStacks As String
Dim cDC As String
Dim eVendorsName As String
Dim WEDating As String

For i = 6 To 30000

WEDating = Sheets("SUPPORT DATA").Range("B4").Value
cStatus = Sheets("TMS DATA").Range("B" & i).Value
cLoad = Sheets("TMS DATA").Range("D" & i).Value
eVendorsName = (Sheets("TMS DATA").Range("H" & i).Value)
cDC = Sheets("TMS DATA").Range("K" & i).Value

If cLoad = "" Then
Exit For
End If

go = False
If cStatus = "COMMITED" Then

cPO = Sheets("TMS DATA").Range("E" & i).Value

tn = Now()
cDat = Weekday(tn, vbMonday)
'condition for fridays
If (cDat = 5) Then
cDay = Format((tn + 2) + WEDating, "Dddd")
cDat = Format((tn + 2) + WEDating, "dd/mm/yyyy")
Else
cDay = Format(tn + WEDating, "Dddd")
cDat = Format(tn + WEDating, "dd/mm/yyyy")
End If

'cDat = Format(Sheets("TMS DATA").Range("R" & i).Value, "dd/mm/yyyy")
CTime = Sheets("TMS DATA").Range("AB" & i).Value
cStacks = Sheets("TMS DATA").Range("N" & i).Value

If Sheets("TMS DATA").Range("AF" & i).Value = "" Then
'get email address
cVendorDC = CStr(Sheets("TMS DATA").Range("G" & i).Value)
cVendorName = (Sheets("TMS DATA").Range("H" & i).Value)

found = False
For j = 6 To 30000
If CStr(Sheets("SUPPORT DATA").Range("D" & j).Value) =
cVendorDC Then
found = True
emailaddr = Sheets("SUPPORT DATA").Range("F" & j).Value
If emailaddr = "" Then
MsgBox (Sheets("SUPPORT DATA").Range("E" & j).Value
& " - does not have a valid email, please change and retry")
Exit For
End If
go = True
Exit For
End If
Next j
If found = False Then
MsgBox ("DC Number : " & cVendorDC & Chr(10) & "DC Name : " &
cVendorName & Chr(10) & Chr(10) & " Was not found, please create an
entry in the data sheet")
End If

If go = True Then
Call Module4.sendEmail(emailaddr, eVendorsName, cLoad, cPO,
cStacks, cDC, cDay, cDat, CTime)
Sheets("TMS DATA").Range("AF" & i).Value = "Y"

End If

End If
End If

Next i

End Sub

Sub sendEmail(emailaddr As String, eVendorsName As String, cLoad As
String, cPO As String, cStacks As String, cDC As String, cDay As String,
cDat As String, CTime As String)
' Is working in Office 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

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

strbody = "Hi, " & Chr(10) & _
"" & Chr(10) & _
"Please be advised that We will be picking up the following
Order(s) :" & Chr(10) & _
"" & Chr(10) & _
"Vendor : " & eVendorsName & Chr(10) & _
"" & Chr(10) & _
"Load ID : " & cLoad & Chr(10) & _
"PO No(s) : " & cPO & Chr(10) & _
"Pallet Stack(s) : " & cStacks & Chr(10) & _
"Bound For : " & cDC & Chr(10) & _
"" & Chr(10) & _
"Day : " & cDay & Chr(10) & _
"Date : " & cDat & Chr(10) & _
"Time : " & CTime & " Approx" & Chr(10) & _
"" & Chr(10) & _
"NOTE:" & Chr(10) & _
"We strive to meet all expected Pick up Arrival times provided
although infrequent events and " & Chr(10) & _
"circumstance outside our control may affect the Pick up Time" &
Chr(10) & _
"" & Chr(10) & _
"Should you have any issues or concerns on the morning of the
pick up please contact the Fleet Controller" & Chr(10) & _
"( As early as possible to avoid potential inconveniences )" &
Chr(10) & _
"" & Chr(10) & _
"Regards, " & Chr(10) & _
"Transport"

On Error Resume Next
With OutMail
.To = emailaddr
.CC = ""
.BCC = ""
.Subject = "Pick-Ups - " & cDat
.Body = strbody
.Display 'or use .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub