helo.

when sending a email, all you realy want to do is build a text string.
and in your case you are creating a large string from many cell over two
worksheets.
You have fully qualified the code (eg
thisworkbook.sheets("shet").range("A1"0.value and thats
good though in this case realy hampers the readability of what you are
doing. you need to make use of WITH statements like below. also to help
the readibility a little when referencing a cell the .value is the
defult propity used so in a case like this i would leave it out. and you
are using a lot of line continuations ( _ ) these only realy help the
readiblity and you are limited to the number of lines the code can
spread so wither pull it into less lines or every now and then break out
and set the variable like below(i think that makes sence)

well anyhow try the below, at lease it should give you a idear of what
needs to happen.


Code:
--------------------
Sub Mail_New_Version()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim Cl As Range
Dim strbody1 As String

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

ActiveWindow.TabRatio = 0.908

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

For Each Cl In ThisWorkbook.Sheets("Report").Range("BJ1:BJ25")
strbody1 = strbody1 & Cl & vbNewLine
Next Cl
With ThisWorkbook
With .Sheets("Master")
strbody1 = strbody1 & .Range("E1") & .Range("E2") & .Range("E3") & _
.Range("E4") & .Range("E5") & .Range("E6") & " "
End With

strbody1 = strbody1 & .Sheets("Report").Range("B62") & .Sheets("Master").Range("E7") & " " & _
.Sheets("Report").Range("B63") & .Sheets("Master").Range("E8") & " " & .Sheets("Report").Range("B64")


With .Sheets("Master")
strbody1 = strbody1 & .Range("E9") & .Range("E10") & .Range("E11") & " "
End With

strbody1 = strbody1 & .Sheets("Report").Range("B33") & .Sheets("Master").Range("E12") & " " & _
.Sheets("Report").Range("B34") & .Sheets("Master").Range("E13") & " " & .Sheets("Report").Range("B35")

With .Sheets("Master")
strbody1 = strbody1 & .Range("E14") & .Range("E15") & .Range("E16") & " "
End With


strbody1 = strbody1 & .Sheets("Report").Range("B56") & .Sheets("Master").Range("E17") & " " & .Sheets("Report").Range("B57") & _
.Sheets("Master").Range("E18") & " " & .Sheets("Report").Range("B58")


With .Sheets("Master")
strbody1 = strbody1 & .Range("E19") & .Sheets("Master").Range("E20") & .Sheets("Master").Range("E21") & " "
End With


strbody1 = strbody1 & .Sheets("Report").Range("B49") & .Sheets("Master").Range("E22") & " " & .Sheets("Report").Range("B50") & _
.Sheets("Master").Range("E23") & " " & .Sheets("Report").Range("B51") & .Sheets("Master").Range("E24") & " " & .Sheets("Report").Range("B52")



With Destwb
On Error Resume Next
With OutMail
.To = .Sheets("Master").Range("B1")
.CC = ""
.BCC = ""
.Subject = .Sheets("Report").Range("B2")
.Body = strbody1
.ReadReceiptRequested = False
.Importance = 1
.Send
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%S"
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

End With

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
--------------------


cheers


--
D_Rennie
------------------------------------------------------------------------
D_Rennie's Profile: 1412
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=172454

Microsoft Office Help