OUTLOOK from Excel
 

I have borrowed this code from a web site which I can not remember at the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying to send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it not being
sent.

3. After selecting and running the macro several times and then bringing up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made instead of the
one email which I want.

Any ideas on how to overcome these problems would be greatly appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 & ":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function

OUTLOOK from Excel
 

Hi

http://www.rondebruin.nl/sendmail.htm#Prevent


3. After selecting and running the macro several times and then bringing up
Task Manager there seems to be many instances of OUTLOOK running.

Because there is a bug in Outlook you must uncheck
"send immediately when connect" in the Outlook options.
ToolsOptionsMail Setup in the Outlook menu bar.

I must go now
If you need more help post back I try to help you this evening


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Matt" wrote in message ...

I have borrowed this code from a web site which I can not remember at the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying to send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it not being
sent.

3. After selecting and running the macro several times and then bringing up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made instead of the
one email which I want.

Any ideas on how to overcome these problems would be greatly appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 & ":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function

OUTLOOK from Excel
 

Hi Matt

Some more Info

The Outlook problem seems to be fixed in Office 2003
Ms don't fix this problem in earlier versions.

So If you have a problem with this then uncheck "send immediately when connect".
I only use CDO on this moment myself because it don't have a problem like this and also
don't have the security warning.

http://www.rondebruin.nl/cdo.htm


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Ron de Bruin" wrote in message ...
Hi

http://www.rondebruin.nl/sendmail.htm#Prevent


3. After selecting and running the macro several times and then bringing up
Task Manager there seems to be many instances of OUTLOOK running.

Because there is a bug in Outlook you must uncheck
"send immediately when connect" in the Outlook options.
ToolsOptionsMail Setup in the Outlook menu bar.

I must go now
If you need more help post back I try to help you this evening


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Matt" wrote in message ...

I have borrowed this code from a web site which I can not remember at the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying to send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it not being
sent.

3. After selecting and running the macro several times and then bringing up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made instead of the
one email which I want.

Any ideas on how to overcome these problems would be greatly appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 & ":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function

OUTLOOK from Excel
 

Matt,

3. After selecting and running the macro several times and then bringing
up
Task Manager there seems to be many instances of OUTLOOK running.

Add the line:
olAPP.Quit

before
Set olMail = Nothing

Setting olApp = Nothing clears memory but doesn't close the App.


HTH
Henry

"Matt" wrote in message
...

I have borrowed this code from a web site which I can not remember at the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying to send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it not
being
sent.

3. After selecting and running the macro several times and then bringing
up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made instead of the
one email which I want.

Any ideas on how to overcome these problems would be greatly appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 & ":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function

OUTLOOK from Excel
 

Thanks , CDO is the go, works like a dream


"Ron de Bruin" wrote in message
...
Hi

http://www.rondebruin.nl/sendmail.htm#Prevent


3. After selecting and running the macro several times and then bringing
up
Task Manager there seems to be many instances of OUTLOOK running.

Because there is a bug in Outlook you must uncheck
"send immediately when connect" in the Outlook options.
ToolsOptionsMail Setup in the Outlook menu bar.

I must go now
If you need more help post back I try to help you this evening


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Matt" wrote in message
...

I have borrowed this code from a web site which I can not remember at
the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying to
send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it not
being
sent.

3. After selecting and running the macro several times and then bringing
up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made instead of
the
one email which I want.

Any ideas on how to overcome these problems would be greatly
appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 &
":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function

OUTLOOK from Excel
 

I have tried the code listed below, it uses CDO and works perfectly from
home, however when I try to send emails from work I get the following
message "Run Time error '-2147220960 (80040220). When I hit Debug it stops
at the line .Send . I can send email using outlook from my computer at
the same time so that I am connect to the internet but when I use CDO I get
this message (at work only). Any ideas what this error message is about.

Thanks
Matt






"Ron de Bruin" wrote in message
...
Hi Matt

Some more Info

The Outlook problem seems to be fixed in Office 2003
Ms don't fix this problem in earlier versions.

So If you have a problem with this then uncheck "send immediately when
connect".
I only use CDO on this moment myself because it don't have a problem like
this and also
don't have the security warning.

http://www.rondebruin.nl/cdo.htm


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Ron de Bruin" wrote in message
...
Hi

http://www.rondebruin.nl/sendmail.htm#Prevent


3. After selecting and running the macro several times and then
bringing up
Task Manager there seems to be many instances of OUTLOOK running.

Because there is a bug in Outlook you must uncheck
"send immediately when connect" in the Outlook options.
ToolsOptionsMail Setup in the Outlook menu bar.

I must go now
If you need more help post back I try to help you this evening


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Matt" wrote in message
...

I have borrowed this code from a web site which I can not remember at
the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying to
send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it not
being
sent.

3. After selecting and running the macro several times and then
bringing up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made instead of
the
one email which I want.

Any ideas on how to overcome these problems would be greatly
appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 &
":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 +
Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function

OUTLOOK from Excel
 

Hi Matt

See the problem section on my page
http://www.rondebruin.nl/cdo.htm#Problems
You must fill in the smtp server in the code

--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Matt" wrote in message ...
I have tried the code listed below, it uses CDO and works perfectly from
home, however when I try to send emails from work I get the following
message "Run Time error '-2147220960 (80040220). When I hit Debug it stops
at the line .Send . I can send email using outlook from my computer at
the same time so that I am connect to the internet but when I use CDO I get
this message (at work only). Any ideas what this error message is about.

Thanks
Matt






"Ron de Bruin" wrote in message
...
Hi Matt

Some more Info

The Outlook problem seems to be fixed in Office 2003
Ms don't fix this problem in earlier versions.

So If you have a problem with this then uncheck "send immediately when
connect".
I only use CDO on this moment myself because it don't have a problem like
this and also
don't have the security warning.

http://www.rondebruin.nl/cdo.htm


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Ron de Bruin" wrote in message
...
Hi

http://www.rondebruin.nl/sendmail.htm#Prevent


3. After selecting and running the macro several times and then
bringing up
Task Manager there seems to be many instances of OUTLOOK running.

Because there is a bug in Outlook you must uncheck
"send immediately when connect" in the Outlook options.
ToolsOptionsMail Setup in the Outlook menu bar.

I must go now
If you need more help post back I try to help you this evening


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Matt" wrote in message
...

I have borrowed this code from a web site which I can not remember at
the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying to
send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it not
being
sent.

3. After selecting and running the macro several times and then
bringing up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made instead of
the
one email which I want.

Any ideas on how to overcome these problems would be greatly
appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 &
":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 +
Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function

OUTLOOK from Excel
 

Thanks, works great now.



"Ron de Bruin" wrote in message
...
Hi Matt

See the problem section on my page
http://www.rondebruin.nl/cdo.htm#Problems
You must fill in the smtp server in the code

--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Matt" wrote in message
...
I have tried the code listed below, it uses CDO and works perfectly from
home, however when I try to send emails from work I get the following
message "Run Time error '-2147220960 (80040220). When I hit Debug it
stops
at the line .Send . I can send email using outlook from my computer
at
the same time so that I am connect to the internet but when I use CDO I
get
this message (at work only). Any ideas what this error message is
about.

Thanks
Matt






"Ron de Bruin" wrote in message
...
Hi Matt

Some more Info

The Outlook problem seems to be fixed in Office 2003
Ms don't fix this problem in earlier versions.

So If you have a problem with this then uncheck "send immediately when
connect".
I only use CDO on this moment myself because it don't have a problem
like
this and also
don't have the security warning.

http://www.rondebruin.nl/cdo.htm


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Ron de Bruin" wrote in message
...
Hi

http://www.rondebruin.nl/sendmail.htm#Prevent


3. After selecting and running the macro several times and then
bringing up
Task Manager there seems to be many instances of OUTLOOK running.

Because there is a bug in Outlook you must uncheck
"send immediately when connect" in the Outlook options.
ToolsOptionsMail Setup in the Outlook menu bar.

I must go now
If you need more help post back I try to help you this evening


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Matt" wrote in message
...

I have borrowed this code from a web site which I can not remember
at
the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying
to
send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it
not
being
sent.

3. After selecting and running the macro several times and then
bringing up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made
instead of
the
one email which I want.

Any ideas on how to overcome these problems would be greatly
appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() *
10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid
the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 &
":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 +
Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function