PDA

View Full Version : HELP, user-defined type not defined



kmurraysa
03-07-2013, 12:16 AM
Hi
I am trying to send an email and attachment from Excel using Outlook using the below code. I cannot use TOOLS/ REFERENCES as this is not enable on my work PC. I know I have to change it too late binding but I am not a prgrammer so can't get this to work as it then gives Variable not defined error. Please help!

Option Explicit
Public strEmail As String
Sub BuildEmail()
Dim strEmailDist As String
Dim strSheetA As String
Dim strRange As Range
Dim strName As Variant
Dim sBody As Variant

Dim strDate As Date
Dim objOutlook As Outlook.Application
Dim objOutlookMail As MailItem
Dim strSubject As String
Set objOutlook = New Outlook.Application
Set objOutlookMail = objOutlook.CreateItem(olMailItem)


strDate = Sheets("REFERENCE SHEET").Cells(1, 2).Value
strSubject = Sheets("REFERENCE SHEET").Cells(1, 1).Value
strEmail = ""


strSheetA = "REFERENCE SHEET"
Application.Sheets(strSheetA).Select

For Each strName In Range(Cells(4, 2), Cells(4, 2).End(xlDown))

strEmail = strEmail & strName & ";"

Next


Sheets("Brokerage Report").Select

Set strRange = Nothing
Set strRange = Range(Cells(8, 2), Cells(1, 1).End(xlDown).Offset(28, 12))


With objOutlookMail

.Subject = strSubject
.BodyFormat = olFormatHTML
.to = strEmail
.HTMLBody = RangetoHTML(strRange)
.Attachments.Add ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
.Display

End With
Set objOutlook = Nothing
Set objOutlookMail = Nothing

End Sub

Function RangetoHTML(strRange As Range)
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"
strRange.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
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
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=")

TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

Doug Robbins
03-07-2013, 12:50 AM
If you cannot set a reference to the Outlook Object Library and want to use Late Binding, you cannot use:

Dim objOutlook As Outlook.Application
Dim objOutlookMail As MailItem

and must use

Dim objOutlook As Object
Dim objOutlookMail As Object

Then use the following to get hold of or create Outlook

On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set objOutlook = CreateObject("Outlook.Application")
bStarted = True
End If
On Error GoTo ErrMsg 'assumes you have an error handler
Set objOutlookMail = objOutlook.CreateItem(0) 'olMailItem

You need to declare bstarted as Boolean and then you if it is true, you use it to quit Outlook as it was started by your application.

Take a look at some of the code in my MergeTools
– 20121103 Add-in that you can download from thefollowing page of my Windows Live SkyDrive:
https://skydrive.live.com/?cid=5aedcb43615e886b#!/?cid=5AEDCB43615E886B!cid=5AEDCB43615E886B&id=5AEDCB43615E886B%21566 (https://skydrive.live.com/?cid=5aedcb43615e886b#!/?cid=5AEDCB43615E886B!cid=5AEDCB43615E886B&id=5AEDCB43615E886B%21566)

kmurraysa
03-07-2013, 01:07 AM
Thanks for your response.

I have substituted the
Dim objOutlook As Object
Dim objOutlookMail As Object
but am not sure what of the below I must actually add to the code. Please excuse my ignorance, I am a complete non-coder!

On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set objOutlook = CreateObject("Outlook.Application")
bStarted = True
End If
On Error GoTo ErrMsg 'assumes you have an error handler
Set objOutlookMail = objOutlook.CreateItem(0) 'olMailItem

You need to declare bstarted as Boolean and then you if it is true, you use it to quit Outlook as it was started by your application.

Bob Phillips
03-07-2013, 02:51 AM
Option Explicit

Public strEmail As String

Enum OLConstants
olFormatHTML = 2
End Enum

Sub BuildEmail()
Dim strEmailDist As String
Dim strSheetA As String
Dim strRange As Range
Dim strName As Variant
Dim sBody As Variant

Dim strDate As Date
Dim objOutlook As Object 'Outlook.Application
Dim objOutlookMail As Object 'MailItem
Dim strSubject As String

Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMail = objOutlook.CreateItem(olMailItem)

strDate = Sheets("REFERENCE SHEET").Cells(1, 2).Value
strSubject = Sheets("REFERENCE SHEET").Cells(1, 1).Value
strEmail = ""

strSheetA = "REFERENCE SHEET"
Application.Sheets(strSheetA).Select

For Each strName In Range(Cells(4, 2), Cells(4, 2).End(xlDown))

strEmail = strEmail & strName & ";"
Next

Sheets("Brokerage Report").Select

Set strRange = Nothing
Set strRange = Range(Cells(8, 2), Cells(1, 1).End(xlDown).Offset(28, 12))

With objOutlookMail

.Subject = strSubject
.BodyFormat = olFormatHTML
.to = strEmail
.HTMLBody = RangetoHTML(strRange)
.Attachments.Add ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
.Display
End With

Set objOutlook = Nothing
Set objOutlookMail = Nothing
End Sub

Function RangetoHTML(strRange As Range)
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"
strRange.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
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
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=")

TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function


Also, take a look at Develop Early, Release Late (http://www.xldynamic.com/source/xld.EarlyLate.html)

Aflatoon
03-07-2013, 04:41 AM
And also
olMailItem = 0
(although it will work without the declaration since it's 0)

Bob Phillips
03-07-2013, 07:59 AM
And also
olMailItem = 0
(although it will work without the declaration since it's 0)

I looked for others but saw none, time to ratchet the glasses up a notch :(