Tip: Other languages are Google-Translated. You can visit the English version of this link.
Log in
x
or
x
x
Register
x

or
×

Macro stopped working after kutools installation

More
7 months 3 weeks ago #1004 by James
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

Please Log in or Create an account to join the conversation.

  • Not Allowed: to create new topic.
  • Not Allowed: to reply.
  • Not Allowed: to edit your message.
Moderators: jaychivoJay Chivo