By Gost v soboto, 01
Objavljeno v Kutools za Excel
odgovori 0
všeč mi je 0
Ogledov 2.6K
Glasov 0
Namestil sem kutools za pomoč pri projektu za delo. Upravljam tudi poročilo velikega podjetja, ki ima makro, ki iz vnesenih informacij ustvari e-pošto. Ta makro je prenehal delovati na mojem računalniku. Deluje na računalnikih, ki nimajo kutoola. Je kdo že naletel na kaj takega? Tukaj je makro, ki dobro deluje na drugih računalnikih:

Sub Mail_Sheet_Outlook_Body()
'Delo v Excelu 2000-2016
Application.ReferenceStyle = xlA1
Dim rng As Range
Zatemnite OutApp kot objekt
Zatemni OutMail kot predmet
Zatemni xFolder kot niz
Dim xSht kot delovni list
Dim xSub kot niz
Zatemni odgovor kot niz
Zatemni sporočilo kot niz
Dim Style As String
Dim Title kot niz

Nastavite xSht = ActiveSheet
Msg = "Ali ste prepričani, da želite poslati ta obrazec po e-pošti?" ' Določite sporočilo.
Slog = vbYesNo + vbCritical + vbDefaultButton2 ' Določite gumbe.
Title = "Potrditev pošiljanja e-pošte" ' Določite naslov.
Odgovor = MsgBox(Sporočilo, slog)

Če je Response = vbYes Potem
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Revizija polja za trgovino " + CStr(xSht.Cells(19, "A").Value)
Z aplikacijo
.EnableEvents = False
.ScreenUpdating = False
Končaj s

Nastavi rng = nič
Nastavite rng = ActiveSheet.UsedRange
'Uporabite lahko tudi ime lista
'Set rng = Sheets("YourSheet").UsedRange

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




On Error Resume Next
Z OutMail
.Do = ""
.CC = ""
.BCC = ""
.Subject = "Povzetek"
.Priloge.Dodaj xFolder
.HTMLBody = RangetoHTML(rng)
.Display 'ali uporabite .Display

Končaj s
Ob napaki Pojdi na 0

Z aplikacijo
.EnableEvents = Res
.ScreenUpdating = Res
Končaj s

Nastavite OutMail = Nič
Nastavite OutApp = Nič
Konec Če
End Sub


Funkcija RangetoHTML(rng kot obseg)
' Delo v pisarni 2000-2016
Dim fso kot objekt
Zatemni kot predmet
Zatemni TempFile kot niz
Dim TempWB kot delovni zvezek

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

Kopirajte obseg in ustvarite nov delovni zvezek, v katerega želite prilepiti podatke
rng.Kopiraj
Nastavi TempWB = Delovni zvezki.Dodaj(1)
S TempWB.Sheets(1)
.Cells(1).PrilepiPosebna pasta:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Celice(1).Izberi
Application.CutCopyMode = Napačno
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
Ob napaki Pojdi na 0
Končaj s

'Objavite list v datoteki htm
Z TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Ime datoteke:=TempFile, _
List:=TempWB.Listi(1).Ime, _
Vir:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Objavi (True)
Končaj s

»Preberi vse podatke iz datoteke htm v RangetoHTML
Nastavite fso = CreateObject ("Scripting.FileSystemObject")
Nastavi ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Zapri
RangetoHTML = Zamenjaj(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

»Zapri TempWB
TempWB.Close savechanges:=False

»Izbrišite datoteko htm, ki smo jo uporabili v tej funkciji
Ubij TempFile
Nastavi ts = Nič
Nastavite fso = Nič
Nastavite TempWB = Nič

End Function
Ogled celotne objave