Excel controlling outlook from excel (body of email)

Joined
Feb 23, 2009
Messages
1
Reaction score
0
Hello all, I am trying a broader search since the forums I have been posting were specifically EXCEL. Below is the problem i am having and I hope to find someone here with a better understanding of outlook.



HI there, I have been working on this for awhile and although I have gotten help via other methods, none of them seem to work in the manner I would like for it to do so. Other methods include, looping, HTML and formatting the string b4 it is imported into

SO this is what I have done, I have taken recorder in outlook and supplied the body of the email with data seperated by commas. Then i recorded the next steps with recorder selected the tools and then tables within outlook. I am trying to make it where excel can control this code that I recorded in outlook. I assume i have to define an object or something but i am missing a step. anyone have any thoughts? thanks so very much in advance.

Ooops, also the code for creating the email was created by someone else, and I have been using it for years for converting a range into HTML and plascing in body of emails...but now, I cant use html
frown.gif


Code:
Sub email()
 
 
Dim TodayFile
Dim FileDate
 
'Sends a specified range to a Outlook message and retains Excel formatting
 
'References needed :
'Microsoft Outlook Object Library := msoutl9olb
'Microsoft Scripting Runtime	 := SCRRUN.DLL
 
'Dimension variables
'// ie. if Ol not installed then we need to Late bind & define as Obj
'// Use Late binding > Outlook.Application > olMail As Outlook.MailItem
'// Plus define olmailItem
Dim olApp As Object, olMail, olMailItem
Dim FSObj As Scripting.FileSystemObject, TStream As Scripting.TextStream
Dim rngeSend As Range, strHTMLBody As String
 
 
'Select the range to be sent
Set rngeSend = Range("B3:J29")
 
'Now create the HTML file
'// Changes by IFM
'// changed "C:\temp\sht.htm" to Dynamically get Sys Temp Dir
'// To cover the instance where Tmp Dir is NOT @ C:\
Dim SysTmp As String
SysTmp = TmpFolderLocation
ActiveWorkbook.PublishObjects.Add(xlSourceRange, SysTmp & "\sht.htm", _
	rngeSend.Parent.Name, rngeSend.Address, xlHtmlStatic).Publish True
 
'Create an instance of Outlook (or use existing instance if it already exists
Set olApp = CreateObject("Outlook.Application")
 
'Create a mail item
Set olMail = olApp.CreateItem(olMailItem)
 
'Open the HTML file using the FilesystemObject into a TextStream object
Set FSObj = New Scripting.FileSystemObject
Set TStream = FSObj.OpenTextFile(SysTmp & "\sht.htm", ForReading)
 
'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = TStream.ReadAll
 
Worksheets("SumPasteTab").Activate
TodayFile = Range("Q27").Value
FileDate = Range("N2").Value
 
attachmnt = "S:\USA-HOUSTON\CPDS\GT FAMM\IctsOnline\Global Trading\Risk Control\Daily GM Tracking\test\" & TodayFile & ".pdf"
 
 
 
'utilization
U_CSAT = Range("D15").Value
U_PSAT = Range("D16").Value
U_LSAT = Range("D17").Value
U_SOG = Range("D18").Value
U_TTL = Range("D19").Value
 
'flat
F_CSAT = Range("F15").Value
F_PSAT = Range("F16").Value
F_LSAT = Range("F17").Value
F_SOG = Range("F18").Value
F_TTL = Range("F19").Value
 
'utilization
FU_CSAT = Range("G15").Value
FU_PSAT = Range("G16").Value
FU_LSAT = Range("G17").Value
FU_SOG = Range("G18").Value
FU_TTL = Range("G19").Value
 
 
 
strbody = FU_CSAT & "," & FU_PSAT & "," & FU_TTL & Chr(13) & _
F_CSAT & "," & F_PSAT & "," & F_TTL & Chr(13) & _
U_CSAT & "," & U_PSAT & "," & U_TTL & Chr(13)
 
 
With olMail
	.To = "[email protected]"
	.Subject = " Global DPR " & Format(Date, "mm-dd-yyyy")
	.Body = str
	'.HTMLBody = strHTMLBody
	'.Attachments.Add (attachmnt)
	.Display
	'.Send
End With
 
 
' Selection.HomeKey Unit:=wdStory
' Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
' Selection.ConvertToTable Separator:=wdSeparateByCommas, NumColumns:=3, _
'	 NumRows:=3, AutoFitBehavior:=wdAutoFitFixed
'	 With Selection.Tables(1)
	'		If .Style <> "Table Grid" Then
	 '		 .Style = "Table Grid"
	 '	 End If
		'	.ApplyStyleHeadingRows = True
		'	.ApplyStyleLastRow = True
		 ' .ApplyStyleFirstColumn = True
		 ' .ApplyStyleLastColumn = True
	 ' End With
 
 
 
End Sub
 
Function TmpFolderLocation() As String
Dim Fso, TFolder
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set TFolder = Fso.getSpecialFolder(2)
 
TmpFolderLocation = TFolder.Path
 
Set Fso = Nothing
Set TFolder = Nothing
 
End Function
 
Back
Top