Sending Excel table via Outlook

[David]

I am trying to send a table from Excel within the body of an Outlook
(lastest versions) to be sent as a fax. Am able to do this, BUT when
the document prints out on the fax machine the formating is off (too
big for the sheet). I am flexible on changing the method I send it to
the fax machine, however it must be sent to the fax via macro. Below
is the code I am using.

Any help would be greatly appreciated.

David

Public Sub DoIt()
'On Error GoTo Handler
Dim EmailAddress(0 To 2) As String
Dim Count As Integer
Dim N As Integer
Dim sRec1(0) As String
Dim sRec2(0 To 1) As String
Dim sRec3(0 To 2) As String

Count = 0

'If Range Email Address1 countains a valid email address then
assign it to a slot in the EmailAddress array
If Len(Range("EmailAddress1").Value) > 2 Then
EmailAddress(Count) = Range("EmailAddress1").Value
Count = Count + 1
End If

'If Range Email Address2 countains a valid email address then
assign it to a slot in the EmailAddress array
If Len(Range("EmailAddress2").Value) > 2 Then
EmailAddress(Count) = Range("EmailAddress2").Value
Count = Count + 1
End If

'If Range Email Address3 countains a valid email address then
assign it to a slot in the EmailAddress array
If Len(Range("EmailAddress3").Value) > 2 Then
EmailAddress(Count) = Range("EmailAddress3").Value
Count = Count + 1
End If

If Count = 0 Then
MsgBox "There were no valid email addresses or fax numbers,
please send manually."
Application.Quit
End If


If Count = 1 Then
sRec1(0) = EmailAddress(0)
EmailActiveSheetInBody sRec1, "Order Confirmation - Test"
End If

If Count = 2 Then
sRec2(0) = EmailAddress(0)
sRec2(1) = EmailAddress(1)
EmailActiveSheetInBody sRec2, "Order Confirmation - Test"
End If

If Count = 3 Then
sRec3(0) = EmailAddress(0)
sRec3(1) = EmailAddress(1)
sRec3(2) = EmailAddress(2)

EmailActiveSheetInBody sRec3, "Order Confirmation - Test"
End If




Exit Sub
Handler:
MsgBox "An error has occured, email and or fax confirmations have not
been sent. Please check email addresses and/or fax numbers."
Application.Quit

End Sub



Public Sub EmailActiveSheetInBody(rasRecipients() As String, _
rsSubject As String)

On Error GoTo Handler
SendHTMLEmail rasRecipients, rsSubject, sGetActiveSheetHTML

Exit Sub
Handler:
MsgBox "An error has occured, email and or fax confirmations have not
been sent. Please check email addresses and/or fax numbers."
Application.Quit

End Sub

Private Function sGetActiveSheetHTML() As String

Dim sFullName As String
Dim fso As Scripting.FileSystemObject
Dim fsoTS As Scripting.TextStream

Application.ScreenUpdating = False
sFullName = Environ$("temp") & Application.PathSeparator _
& Format$(Now(), "yymmddhhmmss") & _
Str(Timer * 100)
ActiveSheet.Copy
With ActiveWorkbook
.Sheets(1).SaveAs sFullName & ".htm", xlHtml
.Close False
End With

Set fso = New Scripting.FileSystemObject
Set fsoTS = fso.GetFile(sFullName & _
".htm").OpenAsTextStream(ForReading, TristateUseDefault)
sGetActiveSheetHTML = fsoTS.ReadAll
fsoTS.Close
Set fsoTS = Nothing
Set fso = Nothing
Kill sFullName & ".htm"
Application.ScreenUpdating = True


End Function

Private Sub SendHTMLEmail(rasRecipients() As String, _
rsSubject As String, rsHTMLBody As String)

Dim olApp As Outlook.Application
Dim olMI As Outlook.MailItem
Dim nRecip As Integer

Set olApp = GetObject("", "Outlook.Application")
Set olMI = olApp.GetNamespace("MAPI").GetDefaultFolder( _
olFolderInbox).Items.Add
With olMI
For nRecip = LBound(rasRecipients) To UBound(rasRecipients)
.Recipients.Add rasRecipients(nRecip)
Next nRecip
.Subject = rsSubject
.HTMLBody = rsHTMLBody
.Send
On Error Resume Next
Do Until olApp.GetNamespace("MAPI").GetDefaultFolder( _
olFolderOutbox).Items.Count = 0
DoEvents
Loop
On Error GoTo 0
End With
Set olMI = Nothing
Set olApp = Nothing

End Sub

 

[Sue Mosher [MVP]]

You're setting the HTMLBody property of the message with the result of the sGetActiveSheetHTML function. That function saves the Excel sheet to an HTML file. I don't see anything that would force the results to a particular page size.

The most likely solution looks like it would be to modify the HTML to add a width attribute to the <table> tag or add <font> tags to reduce the size of the text. I don't have any sample code for optimizing the width of an HTML table, given its existing contents; that's likely to be a pretty complicated venture that you might want to take up on an HTML forum.

You'll also probably have to experiment with your fax machine/software to determine what the optimum width needs to be.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers

 

[Todd Miller]

David

I assume you are using Microsoft Shared Fax service on a Windows 2000 or
WIndows 2003 server. I am basically having the same problem whith my
HTML where the Table tags are not being recognized. I believe the
problme is coming from the fax driver being used by Microsoft. I am
using pretty much the same code, but I have an HTML page built with
variable data, in the code I am also sending a Courtesy copy to an email
address. The email copy comes over great, but the formatting on the fax
is off becuase the TABLE tags are not being rendered. It seems to pick
up the CENTER and BOLD and the List tags, but not the table tags for
some reason. Have you found an answer, if so can you give me a clue. I
have been working on this problem for some time in a web application I
am building.

Thanks Todd.

 

[David]

I got no answer yet. My best thought is to ditch outlook and use
Winfax. I know there have to be a way, I will let you know as soon as
I find it.