PDA

View Full Version : export excel to outlook



tommy1234
01-16-2009, 12:53 PM
Hello
I have an excel worksheet that i want to export specific information.
I create a loop which insert values to an array.
My problem happens when i export the data to outlook.
I create a loop in order to add all the array values to email body, but the only value which appears is the last value in the array.
How can i write all the array value in outlook body ? or another solution ?
This matter is urgent to my work !!! (i added the code below)

Thank you

Sub email_body()
Dim count_row As Integer, loopp As Integer, t As Integer, f As Integer, _
test As Integer, LRU As Integer, u As Integer, m As Integer
Dim sum_range As Range
'Dim pro_code As String, pro_inner_code As String
Worksheets("sheet2").Select
[a1].Select
Selection.CurrentRegion.Select
count_row = Selection.Rows.count
loopp = 1
t = 1
Do While t <= count_row
pro_code = Range("a" & loopp)
test = 0
sum_quantity = 0
sum_quantity1 = 0
inventory = 0
'check how many times the project code repeats
Do While Range("a" & loopp) = pro_code
'counter for repeats
test = test + 1
inventory = Range("j" & loopp)
price = Range("i" & loopp)
pro_inner_code = Range("c" & t)
loopp = loopp + 1
Loop
u = t
m = test + t
arr = 1
If test > 0 Then
For LRU = u To (m - 1)
If Range("c" & u) = pro_inner_code Then
sum_quantity = sum_quantity + Range("f" & u)
Else
'array to collect the data
LRU1(arr) = Range("c" & u)
LRU_quantity(arr) = Range("f" & u)
'sum_quantity1 = sum_quantity1 + Range("f" & u)
arr = arr + 1
End If
u = u + 1
Next
End If
Range("c" & 2, "j" & 5).Copy
Call mail_person
t = t + test
Loop
End Sub

Sub mail_person()
Dim a As Integer, b As Integer
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String, combine As String, item As String, item_name as string
If sum_quantity1 <> 0 Then
combine = "Quantity : " & sum_quantity1
Else
combine = ""
End If
item = Worksheets("sheet1").Range("b2").Value
item_name = Worksheets("sheet1").Range("b3").Value
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
strbody = "Hello" & vbNewLine & vbNewLine & _
"This email was sent to update you on obsolite items " & _
"in your project : " & pro_code & vbNewLine & _
"Inventory : " & inventory & vbNewLine & _
"price : " & price & vbNewLine & _
"Quantity : " & sum_quantity & vbNewLine & _
"Best regards" & vbNewLine & vbNewLine & name
here i need to add the data which the array stores

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Program Obsolite Update -" & item
.body = strbody
.display
End With
On Error GoTo 0

End Sub

georgiboy
01-16-2009, 01:31 PM
Here is a piece of code where i create a string out of ten cells in excel then send them in email via outlook, you may find what you are after in this...

Sub SendEmail()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim email_ As String
Dim subject_ As String
Dim body_ As String
Dim attach_ As String
Dim rCell As Range

' create the string
For Each rCell In Sheet1.Range("A1:A10").Cells
x = x & " " & rCell.Value
Next

Set OutlookApp = CreateObject("Outlook.Application")

email_ = UserForm1.ListBox1.Value
subject_ = "THis is the subject"
body_ = x

'create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = email_
.Subject = subject_
.Body = body_
'.Attachments.Add "C:\FolderName\Filename.txt"
.Send
End With

End Sub

tommy1234
01-16-2009, 01:52 PM
Hello
Is there a solution that can based on my code and just fix the problem with the array ?

Thanks

NukedWhale
01-18-2009, 08:49 PM
Unfortunately, I don't know how to help you with the code. But I did notice that your code has "obsolete" spelled incorrectly.