Instalei o kutools para ajudar em um projeto de trabalho. Também gerencio um relatório de uma grande empresa que possui uma macro criando um e-mail a partir das informações inseridas. Essa macro parou de funcionar no meu computador. Funciona nos computadores que não possuem kutools. Alguém já passou por algo assim antes? Aqui está a macro que funciona bem em outros computadores:
SubMail_Sheet_Outlook_Body()
'Trabalhando no Excel 2000-2016
Application.ReferenceStyle = xlA1
Dim rng como alcance
Dim OutApp como objeto
Escurecer OutMail como objeto
Dim xFolder como String
Dim xSht As Planilha
Dim xSub como string
Resposta de escurecimento como string
Escurecer mensagem como string
Dim Style Como String
Dim Título como String
Definir xSht = ActiveSheet
Msg = "Tem certeza de que deseja enviar este formulário por e-mail?" ' Definir mensagem.
Estilo = vbYesNo + vbCritical + vbDefaultButton2 ' Define botões.
Title = "Confirmação de envio de e-mail" ' Define o título.
Resposta = MsgBox(Msg, Estilo)
Se Resposta = vbSim Então
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Auditoria de campo para loja " + CStr(xSht.Cells(19, "A").Value)
Com aplicação
.EntableEvents = False
.ScreenUpdating = False
Terminar com
Definir rng = Nada
Definir rng = ActiveSheet.UsedRange
'Você também pode usar um nome de planilha
'Set rng = Sheets("YourSheet").UsedRange
Set OutApp = CreateObject("Outlook.Application")
Definir OutMail = OutApp.CreateItem(0)
Dim varCellvalue As Long
On Error Resume Next
Com o OutMail
.Para = ""
.CC = ""
.BCC = ""
.Assunto = "Recapitulação"
.Anexos.Adicionar xFolder
.HTMLBody = RangetoHTML(rng)
.Display 'ou use .Display
Terminar com
Em erro GoTo 0
Com aplicação
.EnableEvents = True
.ScreenUpdating = True
Terminar com
Definir OutMail = Nada
Set OutApp = Nada
Se acabar
End Sub
Função RangetoHTML(rng As Range)
' Trabalhando no Office 2000-2016
Dim fso como objeto
Dim ts como objeto
Dim TempFile como string
Dim TempWB como pasta de trabalho
TempFile = Environ$("temp") & "\" & Format(Agora, "dd-mm-aa h-mm-ss") & ".htm"
'Copia o intervalo e cria uma nova pasta de trabalho para colar os dados em
rng.Copiar
Definir TempWB = Workbooks.Add(1)
Com TempWB.Sheets(1)
.Cells(1).Colar Pasta Especial:=8
.Cells(1).PasteSpecial xlPasteValues, , Falso, Falso
.Cells(1).PasteSpecial xlPasteFormats, , Falso, Falso
.Células(1).Selecione
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = Verdadeiro
.DrawingObjects.Delete
Em erro GoTo 0
Terminar com
'Publica a planilha em um arquivo htm
Com TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Nome do arquivo:=TempFile, _
Planilha:=TempWB.Planilhas(1).Nome, _
Fonte:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publicar (Verdadeiro)
Terminar com
'Lê todos os dados do arquivo htm para RangetoHTML
Defina fso = CreateObject ("Scripting.FileSystemObject")
Defina ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Fechar
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Fechar TempWB
TempWB.Fechar savechanges:=Falso
'Deleta o arquivo htm que usamos nesta função
Matar arquivo temporário
Definir ts = Nada
Definir fso = nada
Definir TempWB = Nada
Função final