Samstag, 01 September 2018
  0 Antworten
  2.7K Besuche
Ich habe kutools installiert, um bei einem Arbeitsprojekt zu helfen. Ich verwalte auch einen großen Unternehmensbericht, der über ein Makro verfügt, das aus eingegebenen Informationen eine E-Mail erstellt. Dieses Makro funktioniert auf meinem Computer nicht mehr. Es funktioniert auf Computern, die nicht über Kutools verfügen. Ist jemand schon einmal auf so etwas gestoßen? Hier ist das Makro, das auf anderen Computern einwandfrei funktioniert:

Sub Mail_Sheet_Outlook_Body()
„Arbeiten in Excel 2000-2016
Application.ReferenceStyle = xlA1
Als Bereich dimmen
Dim OutApp als Objekt
OutMail als Objekt dimmen
Dim xFolder als String
Dim xSht als Arbeitsblatt
Dimmen Sie xSub als String
Antwort als Zeichenfolge dimmen
Nachricht als Zeichenfolge dimmen
Dim-Stil als String
Titel als Zeichenfolge dimmen

Setzen Sie xSht = ActiveSheet
Msg = „Sind Sie sicher, dass Sie dieses Formular per E-Mail versenden möchten?“ ' Nachricht definieren.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Schaltflächen definieren.
Titel = „E-Mail-Sendebestätigung“ ' Titel definieren.
Antwort = MsgBox(Msg, Style)

Wenn Antwort = 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)
Mit Anwendung
.EnableEvents = Falsch
.ScreenUpdating = Falsch
Ende mit

Setze rng = Nichts
Setze rng = ActiveSheet.UsedRange
'Sie können auch einen Blattnamen verwenden
'Setze rng = Sheets("YourSheet").UsedRange

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




On Error Resume Next
Mit OutMail
.An = ""
.CC = ""
.BCC = ""
.Subject = "Zusammenfassung"
.Anlagen.xFolder hinzufügen
.HTMLBody = RangetoHTML(rng)
.Display 'oder verwenden Sie .Display

Ende mit
Bei Fehler GoTo 0

Mit Anwendung
.EnableEvents = Wahr
.ScreenUpdating = Wahr
Ende mit

Setzen Sie OutMail = Nichts
Setze OutApp = Nichts
End If
End Sub


Funktion RangetoHTML(rng As Range)
'Arbeiten in Office 2000-2016
Dim fso als Objekt
Als Objekt dimmen
TempFile als String dimmen
TempWB als Arbeitsmappe dimmen

TempFile = Environ$("temp") & "\" & Format(Jetzt "dd-mm-yy h-mm-ss") & ".htm"

„Kopieren Sie den Bereich und erstellen Sie eine neue Arbeitsmappe, um die Daten einzufügen.“
rng.Kopieren
Setze TempWB = Workbooks.Add(1)
Mit TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Zellen(1).Auswählen
Application.CutCopyMode = Falsch
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
Bei Fehler GoTo 0
Ende mit

'Veröffentlichen Sie das Blatt in einer HTM-Datei
Mit TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Dateiname:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Quelle:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
Ende mit

'Alle Daten aus der HTM-Datei in RangetoHTML lesen
Setze fso = CreateObject ("Scripting.FileSystemObject")
Setze ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Schließen
RangetoHTML = Replacement(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'TempWB schließen
TempWB.Close savechanges:=False

'Löschen Sie die HTM-Datei, die wir in dieser Funktion verwendet haben
Töte TempFile
Setze ts = Nichts
Setzen Sie fso = nichts
Setze TempWB = Nichts

End Function
Es gibt keine Antworten für diesen Eintrag gemacht.