By Gast op zaterdag 01 september 2018
Geplaatst in Kutools for Excel
Antwoorden 0
sympathieën 0
keer bekeken 2.7K
Stemmen 0
Ik heb kutools geïnstalleerd om te helpen met een project voor werk. Ik beheer ook een groot bedrijfsrapport met een macro die een e-mail maakt op basis van ingevoerde informatie. Die macro werkt niet meer op mijn computer. Het werkt op computers die geen kutools hebben. Heeft iemand zoiets al eerder meegemaakt? Hier is de macro die prima werkt op andere computers:

Submail_Sheet_Outlook_Body()
'Werken in Excel 2000-2016
Application.ReferenceStyle = xlA1
Dim rng als bereik
Dim Out-app als object
Dim OutMail als object
Dim xFolder als string
Dim xSht als werkblad
Dim xSub als tekenreeks
Gedimde respons als tekenreeks
Dim bericht als tekenreeks
Dim-stijl als tekenreeks
Titel dimmen als tekenreeks

Stel xSht = ActiveSheet in
Msg = "Weet u zeker dat u dit formulier wilt e-mailen?" 'Definieer bericht.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Knoppen definiëren.
Titel = "Bevestiging e-mail verzenden" ' Definieer titel.
Reactie = MsgBox(Msg, Stijl)

Als Reactie = vbJa Dan
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Veldcontrole voor winkel " + CStr(xSht.Cells(19, "A").Waarde)
Met toepassing
.EnableEvents = False
.ScreenUpdating = False
Eindigt met

Stel rng = niets in
Stel rng = ActiveSheet.UsedRange in
'Je kunt ook een bladnaam gebruiken
'Set rng = Sheets("YourBlad").UsedRange

Stel OutApp = CreateObject ("Outlook.Application") in
Set OutMail = OutApp.CreateItem (0)
Dim varCellwaarde zo lang




On Error Resume Next
Met OutMail
.Naar = ""
.CC = ""
.BCC = ""
.Onderwerp = "Samenvatting"
.Bijlagen.Toevoegen xFolder
.HTMLBody = BereiknaarHTML(rng)
.Display' of gebruik .Display

Eindigt met
On Error GoTo 0

Met toepassing
.EnableEvents = Waar
.ScreenUpdating = True
Eindigt met

Set OutMail = Niets
Set OutApp = Niets
End If
End Sub


Functie BereiknaarHTML(rng als bereik)
' Werken in Office 2000-2016
Dim fso als object
Dimt als object
Dim TempFile als tekenreeks
Dim TempWB als werkboek

TempFile = Environ$("temp") & "\" & Formaat(Nu, "dd-mm-jj h-mm-ss") & ".htm"

'Kopieer het bereik en maak een nieuwe werkmap om de gegevens in te plakken
rng.Kopiëren
Stel TempWB in = Werkmappen.Toevoegen(1)
Met TempWB.Sheets(1)
.Cells(1).PlakkenSpeciaal Plakken:=8
.Cellen(1).PasteSpecial xlPasteValues, , False, False
.Cellen(1).PasteSpecial xlPasteFormats, , False, False
.Cellen(1).Selecteer
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = Waar
.DrawingObjects.Verwijderen
On Error GoTo 0
Eindigt met

'Publiceer het blad naar een htm-bestand
Met TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Bestandsnaam:=TempFile, _
Blad:=TempWB.Sheets(1).Naam, _
Bron:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatisch)
.Publiceren (Waar)
Eindigt met

'Lees alle gegevens uit het htm-bestand in RangetoHTML
Stel fso = CreateObject ("Scripting.FileSystemObject")
Stel ts in = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Sluiten
RangetoHTML = Vervangen(RangetoHTML, "align=center x:publishsource=", _
"align=links x:publishsource=")

'Sluit TempWB
TempWB.Close savechanges:=False

'Verwijder het htm-bestand dat we in deze functie hebben gebruikt
Dood TempFile
Zet ts = niets
Stel fso = Niets in
Stel TempWB = niets in

End Function
Bekijk het volledige bericht