Solved

excel macro to send outlook template

Posted on 2012-04-11
26
729 Views
Last Modified: 2012-04-18
Hi,
I'm having issues with my macro. It should send the data via email using my outlook template, however for some reason when it composes the email, it attaches a file and its not using a template.

Any ideas?

Sub test2()
Dim myOlApp As Object
Dim MyItem As Object
Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItemFromTemplate("H:\FOLDER\Macros\Snapshot.oft")

With MyItem
.To = Sheets("Clients").Range("A1")
.Subject = "Monthly bill"
.HTMLBody = "Test"
'Refer to and fill in variable items in template
.Display
End With
Set MyItem = Nothing
Set myOlApp = Nothing
End Sub
0
Comment
Question by:imjayfrank
  • 16
  • 10
26 Comments
 

Author Comment

by:imjayfrank
Comment Utility
I dug a bit deeper and seems the template is just fine until I add the .HTMLBody.

How can I add the .HTMLBody over the template without it being messed up?

Once I add the .HTMLBody, then the template gets messed up.
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
If you examine the MailItem object (e.g., you can do that by stepping through your code, watching the MyItem variable)

The command:

Set MyItem = myOlApp.CreateItemFromTemplate("H:\FOLDER\Macros\Snapshot.oft")

Actually stores inside the .Body property.

So, when you add the command .HTMLBody = "Test", you are overwriting your template!

I don't know what your template looks like, but if you are trying to tag some text after the template, try this:

Sub test2()
Dim myOlApp As Object
Dim MyItem As Object
Dim strBody As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate("H:\FOLDER\Macros\Snapshot.oft")

    With MyItem
        .To = Sheets("Clients").Range("A1")
        .Subject = "Monthly bill"
        strBody = .Body
        .Body = strBody & vbCrLf & vbCrLf & "Test"
        'Refer to and fill in variable items in template
        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing
End Sub

Open in new window


If your Outlook template contains HTML, then I believe would need to combine the HTML from the template with the HTML from the rest of the body, then set that all at once in the .HTMLBody property.

Cheers,

Dave
0
 

Author Comment

by:imjayfrank
Comment Utility
Thanks Dave. So I changed it to add the following:

strBody = .HTMLBody
.HTMLBody = strBody & vbCrLf & vbCrLf & "Testing 1 2 3"

As my template is HTML. However, what I want to do is not add text under it, but add text IN the template.

Example the template contains a header and footer with a grey box all around. I want to enter text in the middle (replacing the xxxx). Can you do this?

See attached, i had to blur out the company info.
Untitled-1.jpg
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
See this primary tip used for developing your solution:
http://msdn.microsoft.com/en-us/library/dd492012(v=office.12).aspx

Let's assume you want to replace the string "XXXTextToReplaceXXX".  Need to be unique enough with the parameter so you can find it and it doesn't confuse the HTML code as well. E.g., if you use a parameter like %TextToReplace% it will not find it as the HTML code generated from the .OFT file will interpret the % as something else.  I've tested this and saved the template as HTML so I assume that's what's going on with the OFT.  It took me a while (because I thought I was doing something wrong) to figure this out.  In the tip example it uses %Project_Type% so that's what I did in the template and no matter what I did, it would not find it.  I even created ReplyTo as in the tip example to no avail.  That's when I started to look at the bodyHTML that was being generated and it clued me in to this.

Ok - create your code with XXXTextToReplaceXXX in the template, and the code below will work.  I added the routine getNewHTML() to allow you to specify if you wanted your replacement text to be at the 1- beginning, 2- middle, or 3- end of the body.  Note the replacement text is optional and is not used in the function unless you choose the middle option.

I also created a little app, using ranges on the worksheet to specify the path to the OFT, the find and replacement string, and option of beginning, at keyword/middle, or end.  The routine used for that is called: SendEmailWTemplate()

Here's the code:

Option Explicit

Sub test2()
Dim myOlApp As Object
Dim MyItem As Object
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate("H:\FOLDER\Macros\Snapshot.oft")

    With MyItem
        .To = Sheets("Clients").Range("A1")
        .Subject = "Monthly bill"
        
        strNewText = "<p>this is a test</p>"

        '.HTMLBody = getNewHTML(.HTMLBody, strNewText, 1, vbNullString) 'test iAddOption = 0 @ beginning of body
        .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
        '.HTMLBody = getNewHTML(.HTMLBody, strNewText, 3, vbNullString) 'test iAddOption = 2 @ end of body
        
        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing
End Sub
Sub SendEmailWTemplate()
Dim myOlApp As Object
Dim MyItem As Object
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate([oftTemplate]) 'using named range for template path

    With MyItem
        .To = Sheets("Clients").Range("A1")
        .Subject = "Monthly bill"
        
        strNewText = [replaceString]

        Select Case [desiredoption]
            Case 1
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 1, vbNullString) 'test iAddOption = 0 @ beginning of body
            Case 2
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, [findString]) 'test iAddOption = 1 @ replace search string in body
            Case 3
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 3, vbNullString) 'test iAddOption = 2 @ end of body
        End Select
        
        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing
End Sub
Function getNewHTML(strHTML As String, strBodyTagReplace As String, iAddOption As Integer, Optional strBodyTag As String = vbNullString) As String
'Source: Learnings from - http://msdn.microsoft.com/en-us/library/dd492012(v=office.12).aspx
'supports adding at the beginning of the message, before the template, adding in the middle of the existing HTML, or at the end of the message
'iAddOption = 1 'beginning of email body - keys in on <body and inserts after the <body xxx declaration
'iAddOption = 2 'middle of email body (requires a search string to be added)
'iAddOptin = 3 'end of the email body - keys in on and inserts before </body>

Dim intTagStart As Integer
Dim intTagEnd As Integer

    Select Case iAddOption
        Case 1 'Insert at beginning of email body
            intTagStart = InStr(1, strHTML, "<body", vbTextCompare)
            intTagEnd = InStr(intTagStart + 5, strHTML, ">")
            strBodyTag = Mid(strHTML, intTagStart, intTagEnd - intTagStart + 1)
            getNewHTML = Replace(strHTML, strBodyTag, strBodyTagReplace)
        Case 2 'Search for key string and insert in the middle of email body
            getNewHTML = Replace(strHTML, strBodyTag, strBodyTagReplace)
        Case 3 'Append to end of email body
            getNewHTML = Replace(strHTML, "</body>", strBodyTagReplace, 1, 1, vbTextCompare)
    End Select
    
End Function

Open in new window


See attached.

Cheers,

Dave
sendEmailUsingTemplate-r2.xlsm
0
 

Author Comment

by:imjayfrank
Comment Utility
Thanks Dave.

The code looks great.

One question, if I want to replace strNewText to equal a range, how can I do that?

it doesn't seem to like: strNewText = Cells.Range("a3:e60")

Also, if I want to add an additional field to replace? i.e. I added XXXDateXXX to the template which I want to replace with the current date.
0
 

Author Comment

by:imjayfrank
Comment Utility
I figured out the date item.

All thats left is having strNewText as the range.

Thanks!
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
You can't assign a text field to an entire range.  If you want to concatenate those cells together, use ths:

dim vNewText as variant
dim i as long

vNewText = Cells.Range("A3:E60)

for i = lbound(vnewtext) to ubound(vnewtext)
  if strNewText = vbnullstring then
     strNewText = vnewtext(i)
  else
    strNewText = strNewText & vbcrlf & vnewtext(i)
  end if
next i

Open in new window

now, strNewText has the data.

>> Also, if I want to add an additional field to replace? i.e. I added XXXDateXXX to the template which I want to replace with the current date.

Go for it!  Just add the code to the case statement and repeat the statements at each case but with your next findString.

Any other questions?

Cheers,

Dave
0
 

Author Comment

by:imjayfrank
Comment Utility
hmm. doesnt seem to be working right.

i dont.

what's wrong with this?

Sub LightningBolt1_Click()
Dim myOlApp As Object
Dim MyItem As Object
Dim rangebody As Range
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String
Dim strNewText2 As String
Dim vNewText As Variant


Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItemFromTemplate("H:\file.oft")

With MyItem
.bcc = "Clients Names Here"
.cc = "cc here"
.Subject = "subject here"
strBody = .HTMLBody
'Set rangebody = Cells.Range("a3:e60")
'strNewText = "<p>this is a test</p>"
strNewText2 = Date

vNewText = Cells.Range("A3:E60")
Dim i As Long
For i = LBound(vNewText) To UBound(vNewText)
  If strNewText = vbNullString Then
    'strNewText = vNewText(i)
  Else
    strNewText = strNewText & vbCrLf & vNewText(i)
  End If
Next i
         
.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
.HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
.Display
End With
Set MyItem = Nothing
Set myOlApp = Nothing

End Sub

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX")  'Assume this one works.

Let's try this.

strNewText =.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX")
strNewText = .HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")

Now in each line, you can examine strNewText to make sure the changes happend in the first, then the second instance.  Do a instr to test that XXXTextToReplaceXXX exists before the first statement, and that it doesnt and your substitution (or part of it does)

Then do the same on the second.

Finally, add the line:

.HTMLBody = strNewText

PS - why did you comment out line 29?

Dave
0
 

Author Comment

by:imjayfrank
Comment Utility
let me try now.

line 29 was a typo, i didnt comment it out.
0
 

Author Comment

by:imjayfrank
Comment Utility
says this subscript out of range:
strNewText = vNewText(i)

The strnewtext and strnewtext2 worked fine as expected until I tried to have strNewtext be the range.

vNewText = Cells.Range("A3:E60")
Dim i As Long
For i = LBound(vNewText) To UBound(vNewText)
  If strNewText = vbNullString Then
    strNewText = vNewText(i)
 Else
    strNewText = strNewText & vbCrLf & vNewText(i)
  End If
Next i
         
.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
.HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
.HTMLBody = strNewText
.Display
End With
Set MyItem = Nothing
Set myOlApp = Nothing

End Sub

Open in new window

0
 

Author Comment

by:imjayfrank
Comment Utility
same error even when i change .html body to:

strNewText = .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
strNewText = .HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
.HTMLBody = strNewText

Open in new window


subscript out of range:
    strNewText = vNewText(i)
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
Also, that's a large range to be sending the way I teed it up to you.  Let's scrap that.

What you need is a range to HTML function.  Here's a link to Ron deBruin's and I was playing with that on another project, yesterday:
http://www.rondebruin.nl/mail/folder3/mail4.htm

Add that function and use it to convert the range to HTML then do your getHTML function to do replacements.

Dave
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
Comment Utility
Here's your code and it works like a champ!

Option Explicit

Sub LightningBolt1_Click()
Dim myOlApp As Object
Dim MyItem As Object
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate("H:\FOLDER\Macros\Snapshot.oft")

    With MyItem
        .To = Sheets("Clients").Range("A1")
        .Subject = "Monthly bill"

        strNewText = "<p>this is a test</p>"

        '.HTMLBody = getNewHTML(.HTMLBody, strNewText, 1, vbNullString) 'test iAddOption = 0 @ beginning of body
        .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX")    'test iAddOption = 1 @ replace search string in body
        '.HTMLBody = getNewHTML(.HTMLBody, strNewText, 3, vbNullString) 'test iAddOption = 2 @ end of body

        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing
End Sub
Sub SendEmailWTemplate()
Dim myOlApp As Object
Dim MyItem As Object
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate([oftTemplate])    'using named range for template path

    With MyItem
        .To = Sheets("Clients").Range("A1")
        .Subject = "Monthly bill"

        strNewText = [replaceString]

        Select Case [desiredoption]
            Case 1
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 1, vbNullString)    'test iAddOption = 0 @ beginning of body
            Case 2
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, [findString])    'test iAddOption = 1 @ replace search string in body
            Case 3
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 3, vbNullString)    'test iAddOption = 2 @ end of body
        End Select

        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing
End Sub
Function getNewHTML(strHTML As String, strBodyTagReplace As String, iAddOption As Integer, Optional strBodyTag As String = vbNullString) As String
'Source: Learnings from - http://msdn.microsoft.com/en-us/library/dd492012(v=office.12).aspx
'supports adding at the beginning of the message, before the template, adding in the middle of the existing HTML, or at the end of the message
'iAddOption = 1 'beginning of email body - keys in on <body and inserts after the <body xxx declaration
'iAddOption = 2 'middle of email body (requires a search string to be added)
'iAddOptin = 3 'end of the email body - keys in on and inserts before </body>

Dim intTagStart As Integer
Dim intTagEnd As Integer

    Select Case iAddOption
        Case 1    'Insert at beginning of email body
            intTagStart = InStr(1, strHTML, "<body", vbTextCompare)
            intTagEnd = InStr(intTagStart + 5, strHTML, ">")
            strBodyTag = Mid(strHTML, intTagStart, intTagEnd - intTagStart + 1)
            getNewHTML = Replace(strHTML, strBodyTag, strBodyTagReplace)
        Case 2    'Search for key string and insert in the middle of email body
            getNewHTML = Replace(strHTML, strBodyTag, strBodyTagReplace)
        Case 3    'Append to end of email body
            getNewHTML = Replace(strHTML, "</body>", strBodyTagReplace, 1, 1, vbTextCompare)
    End Select

End Function

Sub LightningBolt1_Click()
Dim myOlApp As Object
Dim MyItem As Object
Dim rangebody As Range
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String
Dim strNewText2 As String


    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate("C:\Users\dmbw\AppData\Roaming\Microsoft\Templates\test html.oft")

    With MyItem
        .bcc = "Clients Names Here"
        .cc = "cc here"
        .Subject = "subject here"
        strBody = .HTMLBody
        'Set rangebody = Cells.Range("a3:e60")
        'strNewText = "<p>this is a test</p>"
        strNewText = RangetoHTML(Range("A3:E60"))
        strNewText2 = Date

        .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX")    'test iAddOption = 1 @ replace search string in body
        .HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing

End Sub

Open in new window


In a separate public module (just to keep the standard function separate) is Ron's code:
Option Explicit

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Open in new window


Cheers,

Dave
sendEmailUsingTemplate-r3.xlsm
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
PS - the code I gave you for variant = range won't work for the range you've selected, it works for a one dimensional range.  We don't need it anyway, the RangeToHTML should give you a good representation of what the worksheet looks like.  There's also a way to copy and paste it in as a picture and if we need that, I can dig up a link to a past solution that has that approach.

Dave
0
 

Author Comment

by:imjayfrank
Comment Utility
i added the function, your right in that it doesnt work right with the range now.

i tried your last code change and it bring up the email with the range but not the template.

I don't need to copy and paste as a picture, just want to get the data in the template.

how can i do it?
0
 

Author Comment

by:imjayfrank
Comment Utility
snippet
'strNewText = "<p>this is a test</p>"
strNewText = RangetoHTML(Range("A3:E60"))
strNewText2 = Date

'vNewText = Cells.Range("A3:E60")
'Dim i As Long
'For i = LBound(vNewText) To UBound(vNewText)
  'If strNewText = vbNullString Then
    'strNewText = vNewText(i)
 'Else
    'strNewText = strNewText & vbCrLf & vNewText(i)
 ' End If
'Next i
         
.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
.HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
.HTMLBody = strNewText
.Display
End With
Set MyItem = Nothing
Set myOlApp = Nothing

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
Its working for me with a top and bottom picture and two replacement strings in the middle - see my template, attached and try the Excel file I uploaded for testing.  

Then, with your setup, make sure your replacement text strings exist, open your template and validate.


See attached,

DOWNLOAD the template then RENAME extension to .OFT

Cheers,

Dave
Test-HTML--2-.zip
0
 

Author Comment

by:imjayfrank
Comment Utility
i tested with your .oft and it pastes the range but no template.

did you look at my code? am i doing something different?
0
 

Author Comment

by:imjayfrank
Comment Utility
disregard. i got it!

i had to comment out: .HTMLBody = strNewText


thanks again dave!
0
 

Author Closing Comment

by:imjayfrank
Comment Utility
Great answer, great person, great to deal with!
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
Thanks for your kind words.  You know, I'd never had to work with MS Outlook templates nor modifying HTML against a template. It took some digging and couldn't find anyone who'd used a template, then did string replacement in the HTML at the same time - so it was really new development for me rather than adapting something that already existed (albeit, not from scratch).

So, thanks for that question as I enjoyed working with you and the overall experience as well!

Dave
0
 

Author Comment

by:imjayfrank
Comment Utility
hey dave,
"There's also a way to copy and paste it in as a picture and if we need that, I can dig up a link to a past solution that has that approach."

can you pass that along please? I want to try that  and see if my sheet comes out better if as an image.
0
 

Author Comment

by:imjayfrank
Comment Utility
hey dave,
"There's also a way to copy and paste it in as a picture and if we need that, I can dig up a link to a past solution that has that approach."

can you pass that along please? I want to try that  and see if my sheet comes out better if as an image.
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
I thought I did respond to your last question.  Sorry about that - the website and I (one of "us" anyway) went bonkers :)

Here's the link to past solution where I crafted a modified RangeToHTML2() routine.  The HTML would need to be merged to whatever you already have:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Objects/Q_27563263.html

Here's code I believe Ron deBruin authored, which uses the publishObjects approach:

Public Function RangetoHTML2()
' You can't use this function in Excel 97
Dim fso As Object
Dim ts As Object
Dim TempFile As String

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    With ActiveWorkbook.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=ActiveSheet.Name, _
         Source:=ActiveSheet.UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML2 = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    Kill TempFile
End Function

Open in new window


The code posted might be more flexible than my copy to GIF then import into HTML approach in my modified RangeToHTML2 approach.  The function needs to be modified so you can pass it the range rather than using the activesheet's used range.

Cheers,

Dave
0
 

Author Comment

by:imjayfrank
Comment Utility
cheers!
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This collection of functions covers all the normal rounding methods of just about any numeric value.
Article by: Leon
Software Metering within our group of companies has always been an afterthought until auditing of software and licensing became a pain point. Orchestrator and SCCM metering gave us the answer and it was an exciting process.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now