Több elem a .Htmlbody után

Több elem a .Htmlbody után
2008-05-06T15:17:07+02:00
2008-05-06T15:56:48+02:00
2022-11-09T11:41:54+01:00
chesti
Hello.

Légyszives segítsetek!
Egy levélben szertnék bemásolni 4db hmtl állományt egymás után és ezt küldeni outlookból.
Ami nagyon idegesít, hogy működött is, multhéten amikor összeraktam, de most valahogy sehogysem.
Miondig csak az elsőt rakja be .htmlbody= után közvetlen állót. A html másolás jól lemegy,az jó. Lehet nem igy kell megoldani a bemásolást az outlookba, de nemértem, hogy akkor miért volt jó multhéten.
Köszönöm h valaki fordít rám kis energiát és segít.



Function elküldés()

Dim OutApp As Object
Dim OutMail As Object
Dim anyagkod As Integer



Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)



With OutMail
.to = "xxx@gg.hu"
.CC = ""
.Subject = "Standard Commercial No 1." & " - " + Format$(Forms![sc no 1]![mezo].Value, "yyyy-mm-dd")



.htmlbody = fosos(1) + fosos(2) + fosos(3) + fosos(4)


.Attachments.Add CurrentProject.Path + "\Standard Commercial N.1 Ferrous " & rhonap & ".xls"
.Attachments.Add CurrentProject.Path + "\Standard Commercial N.1 Non-Ferrous " & rhonap & ".xls"
.Attachments.Add CurrentProject.Path + "\Standard Commercial N.1 Battery " & rhonap & ".xls"
.Attachments.Add CurrentProject.Path + "\Standard Commercial N.1 Paper " & rhonap & ".xls"

.NoAging = True


.Display






End With


EnableEvents = True
ScreenUpdating = True


Set OutMail = Nothing
Set OutApp = Nothing





End Function








Private Function fosos(anyagkod)

Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
Dim oExcel As Excel.Application
Dim forras As String
Dim name As String
Dim tipus As String
Dim rng As String
Dim szam As Integer


If anyagkod = 1 Then tipus = "ferrous"
If anyagkod = 2 Then tipus = "non-ferrous"
If anyagkod = 3 Then tipus = "battery"
If anyagkod = 4 Then tipus = "paper"

name = "Standard Commercial N.1 " & tipus & " " & rhonap & ".xls"







Set oExcel = CreateObject("Excel.Application")


With oExcel


.Workbooks.Open CurrentProject.Path + "\" + name
Set TempWB = .ActiveWorkbook


szam = .Range("a100").End(xlUp).Row + 2

With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=CurrentProject.Path + "\TEMP.htm", _
Sheet:="rec", _
Source:=("1:" & szam & ""), _
HtmlType:=xlHtmlStatic)
.Publish (True)


End With


.Application.displayalerts = False
.ActiveWindow.Close

End With

oExcel.Quit

TempFile = CurrentProject.Path + "\TEMP.htm"



Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
fosos = ts.readall
ts.Close
fosos = Replace(fosos, "align=center x:publishsource=", _
"align=left x:publishsource=")

Kill CurrentProject.Path + "\TEMP.htm"





Set anyagkod = Nothing
Set oExcel = Nothing
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing

End Function
Mutasd a teljes hozzászólást!
Egy levélben szertnék bemásolni 4db hmtl állományt egymás után


Az érdekel, hogy mindegyiknek a végén van-e </html>, mert az nem szerencsés (meg a </body> se, meg....
Mutasd a teljes hozzászólást!

Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd