Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
| Search | Today's Posts | Mark Forums Read
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
  #1 (permalink)  
Old December 28th, 2004, 05:13 PM
Authorized User
 
Join Date: Dec 2004
Location: , , .
Posts: 16
Thanks: 0
Thanked 1 Time in 1 Post
Default Preserve Hyperlinks when Sending HTML Worksheet

Hello! Very excited to find a place where I can ask questions.

Here's my problem:
I am sending a Spreadsheet in the body of an email from Excel. This sheet contains hyperlinks to workbooks on my corporate network. The hyperlinks work fine from an email if I send it using the toolbar buttons. If I send it using VBA (by importing it into the body as an HTML document) the hyperlinks bring up a "Locate Link Browser" dialogue box. Any idea how I can change my code/edit the hyperlinks to properly link to the workbooks? Thanks!

Here's the code I'm using to translate and send the worksheet.

Sub SendEmail(ByVal Recipient As String, SubText As String)
Dim Outlook As Object
Dim Namespace As Object
Dim MailItem As Object

Set Outlook = CreateObject("Outlook.application")
Set MailItem = Outlook.CreateItem(0)

With MailItem
.Subject = SubText
.Recipients.Add Recipient
.HTMLBody = SheetToHTML(ActiveSheet)
.send
End With

End Sub

Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 04-Nov-2003

Dim TempFile As String
Dim Nwb As Workbook
Dim myshape As Shape
Dim fso As Object
Dim ts As Object

sh.Copy
Set Nwb = ActiveWorkbook
For Each myshape In Nwb.Sheets(1).Shapes
myshape.Delete
Next
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile

End Function

  #2 (permalink)  
Old December 30th, 2004, 11:47 AM
Authorized User
 
Join Date: Dec 2004
Location: , , .
Posts: 16
Thanks: 0
Thanked 1 Time in 1 Post
Default

So, solved my own problem with a little more research.. Replaced all that code with the code below. Works perfectly.

Function SendMsoMail(ByVal Recipient As String, Subtext As String)

  Dim oMailEnv As MsoEnvelope
  Dim oMailItem As MailItem

  Set oMailEnv = ActiveSheet.MailEnvelope
  With oMailEnv
    .Introduction = Subtext
    Set oMailItem = .Item
    With oMailItem
      .BodyFormat = olFormatHTML
      .Recipients.Add Recipient
      .Recipients.ResolveAll
      .Send
    End With
  End With

End Function

  #3 (permalink)  
Old December 31st, 2004, 02:28 PM
Authorized User
 
Join Date: Dec 2004
Location: , , .
Posts: 16
Thanks: 0
Thanked 1 Time in 1 Post
Default

Yay! A new problem. Here it is:

This code works fine when I test it. (That's not the problem :)
This code is supposed to run at the end of a process which creates the sheet that it is sending, and prints off a copy of all the sheets included in the list. For some reason when it is run after this process it gives me a debug error complaining about the MsoEnvelope. If I hit debug and then resume, it completes fine. That's fine for me, but when other people use it, that's obviously not going to fly. Any idea what could be causing this? Thanks!!

  #4 (permalink)  
Old January 4th, 2005, 02:49 PM
Authorized User
 
Join Date: Dec 2004
Location: , , .
Posts: 16
Thanks: 0
Thanked 1 Time in 1 Post
Default

Fixed my problem.. again. :)

Looks like I just needed to have a pause between printing and trying to email.. A simple Application.wait, shown below, fixed the problem right up.

  newHour = Hour(Now())
  newMinute = Minute(Now())
  newSecond = Second(Now()) + 2
  waitTime = TimeSerial(newHour, newMinute, newSecond)
  Application.Wait waitTime


  #5 (permalink)  
Old February 8th, 2005, 02:52 PM
Authorized User
 
Join Date: Dec 2004
Location: , , .
Posts: 16
Thanks: 0
Thanked 1 Time in 1 Post
Default

Been awhile.. the application.wait stopped working soon after I started using it. Strange eh? No clue why this won't send, so any help will be very appreciated.. Here's the code as it stands now. :(

Calling line:
Call SendMsoMail(Worksheets("Setup").Cells(21, 2).Value, "Current Day Actions")


Function SendMsoMail(ByVal Recipient As String, Subtext As String)
  On Error GoTo Damned:
  Dim oMailEnv As MsoEnvelope
  Dim oMailItem As MailItem

  newHour = Hour(Now())
  newMinute = Minute(Now())
  newSecond = Second(Now()) + 2
  waitTime = TimeSerial(newHour, newMinute, newSecond)
  Application.Wait waitTime

  Set oMailEnv = ActiveSheet.MailEnvelope
  With oMailEnv
    .Introduction = InputBox("Enter Reason's for Rebooks or Cancels; or just hit OK", "Introduction Text", Subtext)
    Set oMailItem = .Item
    With oMailItem
      .SentOnBehalfOfName = "SSGA-PRICING-GROUP"
      .BodyFormat = olFormatHTML
      Do Until .Recipients.Count = 0
        .Recipients.Remove (1)
      Loop
      .Recipients.Add Recipient
      .Recipients.ResolveAll
      Application.Wait waitTime
      Windows.Application.ActiveWorkbook.Activate
      .Send
    End With
  End With

Exit Function
Damned:
MsgBox "There was an error sending your email." & Chr(10) & "Please click the send email in body of text button to send."

End Function


Similar Threads
Thread Thread Starter Forum Replies Last Post
Sending HTML Mailer With SWF cancer10 Classic ASP Databases 1 November 16th, 2007 08:48 AM
Sending info to HTML forms.... Sildaekar C++ Programming 0 April 2nd, 2007 01:24 PM
Sending Html Emails through DTS cvnitkumar SQL Server DTS 1 January 9th, 2007 01:00 PM
Copy a Worksheet as HTML pakman Excel VBA 3 April 14th, 2005 11:53 AM
ASP Form to Database to HTML Hyperlinks remnatch Access ASP 1 August 9th, 2004 10:38 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.