Это работает для меня
Sub esendtable()
Dim rng As Range
Dim Outlook As Object
Dim newEmail As Object
Dim SigString As String
Dim Signature As String
Dim xInspect As Object
Dim pageEditor As Object
Set rng = Nothing
On Error Resume Next
' Only send the visible cells in the selection.
Set rng = ActiveSheet.Range("A3:F3")
' You can also use a range with the following statement.
Set rng = Sheets("YourSheet").Range("A3:F3").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set Outlook = CreateObject("Outlook.Application")
Set newEmail = Outlook.CreateItem(0)
SigString = "C:\Users\chipz\AppData\Roaming\Microsoft\Signatures\chipz_1.htm" ' Change chipz in path and signature file name
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With newEmail
.To = "recipient@test.com"
.CC = ""
.BCC = ""
.Subject = "Data - " & Date
.BodyFormat = olFormatHTML
.HTMLBody = RangetoHTML(rng) & "" & Signature
.Display
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
'.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set newEmail = Nothing
Set Outlook = Nothing
Set newEmail = Nothing
Set Outlook = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Ron de Bruin
'
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Если соответствие точному формату сериализации Firefox не является Вашей целью, Вы могли пользоваться одной из библиотек сериализации/десериализации JSON JavaScript, перечисленных в http://json.org . Используя стандартную схему как JSON может быть лучше, чем имитация собственного формата Геккона.
Вы могли сделать что-то вроде этого:
Object.prototype.getSource = function() {
var output = [], temp;
for (var i in this) {
if (this.hasOwnProperty(i)) {
temp = i + ":";
switch (typeof this[i]) {
case "object" :
temp += this[i].getSource();
break;
case "string" :
temp += "\"" + this[i] + "\""; // add in some code to escape quotes
break;
default :
temp += this[i];
}
output.push(temp);
}
}
return "{" + output.join() + "}";
}
См. также форматирование данных JavaScript / симпатичный принтер . Я думаю стандартный экспорт в допустимом формате JS, таким образом, это может быть оценка для возвращения его.
[РЕДАКТИРОВАНИЕ] На самом деле, нет! Это хорошо для быстрого дампа, но не для реальной сериализации. Я улучшил его, результат ниже:
function SerializeObject(obj, indentValue)
{
var hexDigits = "0123456789ABCDEF";
function ToHex(d)
{
return hexDigits[d >> 8] + hexDigits[d & 0x0F];
}
function Escape(string)
{
return string.replace(/[\x00-\x1F'\\]/g,
function (x)
{
if (x == "'" || x == "\\") return "\\" + x;
return "\\x" + ToHex(String.charCodeAt(x, 0));
})
}
var indent;
if (indentValue == null)
{
indentValue = "";
indent = ""; // or " "
}
else
{
indent = "\n";
}
return GetObject(obj, indent).replace(/,$/, "");
function GetObject(obj, indent)
{
if (typeof obj == 'string')
{
return "'" + Escape(obj) + "',";
}
if (obj instanceof Array)
{
result = indent + "[";
for (var i = 0; i < obj.length; i++)
{
result += indent + indentValue +
GetObject(obj[i], indent + indentValue);
}
result += indent + "],";
return result;
}
var result = "";
if (typeof obj == 'object')
{
result += indent + "{";
for (var property in obj)
{
result += indent + indentValue + "'" +
Escape(property) + "' : " +
GetObject(obj[property], indent + indentValue);
}
result += indent + "},";
}
else
{
result += obj + ",";
}
return result.replace(/,(\n?\s*)([\]}])/g, "$1$2");
}
}
indentValue может быть пустым, "" "", ", \t" или что бы то ни было. Если ноль, никакое добавление отступа, производит довольно компактный результат (мог использовать меньше пробелов...).
я мог использовать массив для укладки результатов, затем присоединяются к ним, но если у Вас нет гигантских объектов, конкатенация строк должна быть достаточно хорошей...
Также не обрабатывает циклические ссылки...