Skip to main content
Support is Online
We're back! We are here to assist you. Please be patient, we will respond to your tickets shortly.
Official support hours
Monday To Friday
From 09:00 To 17:30
  Saturday, 01 September 2018
  0 Replies
  2.4K Visits
0
Votes
Undo
I installed kutools to assist with a project for work. I also manage a large company report that has a macro creating an email from entered information. That macro has stopped working on my computer. It works on the computers that do not have kutools. Has anyone run into something like this before? Here is the macro that works just fine on other computers:

Sub Mail_Sheet_Outlook_Body()
'Working in Excel 2000-2016
Application.ReferenceStyle = xlA1
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim xFolder As String
Dim xSht As Worksheet
Dim xSub As String
Dim Response As String
Dim Msg As String
Dim Style As String
Dim Title As String

Set xSht = ActiveSheet
Msg = "Are you sure you want to email this form?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Email send confirmation" ' Define title.
Response = MsgBox(Msg, Style)

If Response = vbYes Then
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Field Audit for store " + CStr(xSht.Cells(19, "A").Value)
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
Set rng = ActiveSheet.UsedRange
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim varCellvalue As Long




On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Recap"
.Attachments.Add xFolder
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Display

End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End If
End Sub


Function RangetoHTML(rng As Range)
' Working in Office 2000-2016
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
There are no replies made for this post yet.