i am hoping i'm not breaking any protocol or ettiquette, i did post this on another site, my apologies if i am, but i have been working on this all day and can't figure this out, and i'm a bit desperate 
I am new to VBA and am looking for some assistance.
i found a great tutorial from Ron DeBruin, for emailing as html in outlook. i was hoping someone could help me adapt the code i have to fit my needs.
What i am looking to do is this;
i have a folder that has 70+ workbooks, all of them named for a different region of the U.S.
i would like to change the code i am using to let me choose the folder with all my workbooks (it changes from month to month), take the first worksheet in each workbook and create individual emails in outlook for each workbook.
Ideally I'd like it to be able to associate the name of the workbook with a distribution group in outlook, but i'll settle with just having the email open and i'd type that in myself.
I'm using both office 2007 and 2010.
Thank you all in advance!
here's the code that i currently have working as of today:
I am new to VBA and am looking for some assistance.
i found a great tutorial from Ron DeBruin, for emailing as html in outlook. i was hoping someone could help me adapt the code i have to fit my needs.
What i am looking to do is this;
i have a folder that has 70+ workbooks, all of them named for a different region of the U.S.
i would like to change the code i am using to let me choose the folder with all my workbooks (it changes from month to month), take the first worksheet in each workbook and create individual emails in outlook for each workbook.
Ideally I'd like it to be able to associate the name of the workbook with a distribution group in outlook, but i'll settle with just having the email open and i'd type that in myself.
I'm using both office 2007 and 2010.
Thank you all in advance!
here's the code that i currently have working as of today:
Code:
Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 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 workbook to receive the data.
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 an .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 the RangetoHTML subroutine.
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
' Build the string that you want to add.
' Delete the htm file.
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
Dim StrBody As String
End Function
Sub Jims_Mail_Sheet_Outlook_Body()
' You need to use this module with the RangetoHTML subroutine.
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Dim StrBody As String
' Build the string that you want to add.
StrBody = "Here is this months Idle 180 days product report for your region" & "<br>" & _
"This is line 2" & "<br>" & _
"This is line 3" & "<br><br><br>"
Set rng = Nothing
Set rng = ActiveSheet.UsedRange
' You can also use a sheet name here.
'Set rng = Sheets("YourSheet").UsedRange
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Idle 180 Days Report - " & Worksheets("sheet1").Range("k21")
.HTMLBody = StrBody & RangetoHTML(rng)
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
