Серый форум — VBScript: Вставка линии в документ Word

Re: VBScript: Вставка линии в документ Word

null@example.com (wooch) — Tue, 17 May 2011 06:12:05 +0000

Вообщем, огромное вам спасибо, все работает как надо

Re: VBScript: Вставка линии в документ Word

null@example.com (BeS Yara) — Mon, 16 May 2011 11:52:36 +0000

Немного причесал HTA-шку(идея утилиты понравилась, решил украсить):




  
  Формирование подписи в Outlook 2003,2007
  
  







Имя пользователя 



Должность 



Отделение 



Телефон 



Факс 



Русский        English

P.S. Как говорится, на вкус и цвет... Цвета, шрифты, иконку и т.д. менять в самом начале

Re: VBScript: Вставка линии в документ Word

null@example.com (BeS Yara) — Mon, 16 May 2011 10:56:03 +0000

Xameleon, благодарю за разъяснения - исчерпывающе и доходчиво

Re: VBScript: Вставка линии в документ Word

null@example.com (Xameleon) — Mon, 16 May 2011 10:45:26 +0000

2 BeS Yara:

BeS Yara пишет:

P.P.S. никогда не задумывался, зачем WScript перед CreateObject, копипаста рулила. Надо будет на досуге с этим разобраться

В кратце - в WSH можно использовать WScript.CreateObject и просто CreateObject

Разница в том, что обычный CreateObject

принимает следующие аргументы

CreateObject(servername.typename [, location])

servername 
Required. The name of the application providing the object.

typename 
Required. The type or class of the object to create.

location 
Optional. The name of the network server where the object is to be created.

В большинстве случаев второй параметр (location - имя удалённого сервера на котором будет создан объект) не используется. Он опциональный. Поэтому в основном вызов выглядит как

Set obj = CreateObject("servername.typename")

а с сервером

Set obj = CreateObject("servername.typename","\\servername")

подробнее...

В случае с WScript.CreateObject, полное описание функции выглядит так

WScript.CreateObject(strProgID, [strSubPrefix])

strProgID - это тот же servername.typename, что и в обычной функции CreateObject, а вот strSubPrefix нужен для подключения созданного объекта к событиям по префиксу. Он тоже опциональный (необязательный). И его мы тоже используем в крайних случаях.

Set objIE = WScript.CreateObject("InternetExplorer.Application","objIE_")
objIE.Visible = True
boolBrowserRunning = True 
 
Do While objIE.Visible
    WScript.Sleep 500
Loop

Sub objIE_NavigateComplete2(ByVal pDisp, URL)
    WScript.Echo "You just navigated to", URL
End Sub 
 
Sub objIE_OnQuit()
    boolBrowserRunning = False
End Sub

пример взят с www.devguru.com

Подводя итоги:
set o = WScript.CreateObject("servername.typename")
и
set o = CreateObject("servername.typename")
практически одно и тоже

а вот

set o = WScript.CreateObject("servername.typename","\\server")
и
set o = CreateObject("servername.typename","obj_")

уже всё таки разные вещи. )

Re: VBScript: Вставка линии в документ Word

null@example.com (BeS Yara) — Mon, 16 May 2011 10:19:18 +0000

wooch пишет:

как только я его вставляю в HTML или HTA то снова появляется этот лишний абзац

Самая первая ошибка это "On Error Resume Next"
Отключаем ингнорирование ошибок, запускаем и видим "Ошибка: требуется объект WScript"
Находим тему: "HTA: не найден объект Wscript"

Xameleon пишет:

WScript доступен ТОЛЬКО в WSH.

Однако тут "Администрирование - HTML-приложения" выяснилось что не всё так плохо - меняем WScript.CreateObject на CreateObject и скрипт начинает работать из HTA.

В HTA нельзя напрямую использовать методы и свойства базового класса WScript. Методы CreateObject(.), GetObject(), ConnectObject(, ), DisconnectObject() вызываются без указания родительского класса, а все остальные методы базового класса не доступны для использования.

P.S. Наверно стоило бы в статье на сайте по HTA добавить информацию по использованию Wscript ...
P.P.S. никогда не задумывался, зачем WScript перед CreateObject, копипаста рулила. Надо будет на досуге с этим разобраться

Re: VBScript: Вставка линии в документ Word

null@example.com (wooch) — Mon, 16 May 2011 08:44:41 +0000

Спасибо, ваш скрипт работает на ура, но как только я его вставляю в HTML или HTA то снова появляется этот лишний абзац, вот ломаю голову почему это может происходить. Ниже пример моего HTA документа (извиняюсь что без тега Code - иначе все путается)



 Signature

 





Русский        English 

Имя пользователя                 

Должность                            

Отделение                            

Телефон                               

Факс

Re: VBScript: Вставка линии в документ Word

null@example.com (BeS Yara) — Fri, 13 May 2011 09:34:46 +0000

wooch пишет:

Первые байты 3C 68

Т.е. "" - другими словами, ни под один из BOM-ов указанных на вики не подходит. Значит кодировка - ASCII.

wooch пишет:

Вот нашел упрощенный вариант:

Хорошо, открывающий тэг убрали(кстати, зачем убирать div?), а закрывающий?
Собрал два в одном, добавил запись в файл(только вставку лого закоментировал):


On Error Resume Next

strRegard = "Best _regards, "
strPhoneT = "Tel.: "
strFaxT = "Fax: "
strQua = "If you are not entirely satisfied with our service please contact: "
strGreen = "Please Consider the Environment before printing this Email."
Dim Signature: Signature = "Podpis02"

strName = name_1.value
strTitle = Title_1.value
strDepartment = Branch.value
strPhone = tel.value
strFax = fax.value
strEmail = "quality@mail.com"
strWeb = "www.mail.com"
strLogo = "\\mail.com\greenpeace.gif"

Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

objSelection.Font.Name = "Georgia"
objSelection.Font.Size = "10"
objSelection.Font.Color = RGB (0, 0, 0)
objSelection.Paragraphs.Space1

Set objSelectionLine = objWord.Selection.InlineShapes.AddHorizontalLineStandard
With objSelectionLine
    .Width = 200
    .HorizontalLineFormat.Alignment = 0
End With

objSelection.TypeText strRegard

objSelection.TypeText strName
objSelection.TypeText CHR(11)

objSelection.Font.Italic = True
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)

objSelection.Font.Italic = False
objSelection.Font.Bold = True
objSelection.TypeText strDepartment
objSelection.TypeText CHR(11)

objSelection.Font.Bold = False
objSelection.TypeText strPhoneT & strPhone
objSelection.TypeText CHR(11)

objSelection.TypeText strFaxT & strFax
objSelection.TypeText CHR(11)

objselection.font.color = RGB(0, 0, 255)

Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, strWeb, "", "", strWeb)
hyp.Range.Font.Bold = True
hyp.Range.Font.Size = "10"
hyp.Range.Font.Name = "Georgia"
objSelection.TypeText CHR(11)

objSelection.Font.Name = "Times New Roman"

objSelection.Font.Size = "8"

objSelection.Font.Color = RGB (0, 0, 0)
objSelection.Font.Bold = True
objSelection.TypeText strQua
Set hyp = objSelection.Hyperlinks.Add (objSelection.range, "mailto:" & strEmail, , , strEmail)
hyp.Range.Font.Bold = True
hyp.Range.Font.Color = RGB (0,0,139)
hyp.Range.Font.Size = "8"
hyp.Range.Font.Name = "Times New Roman"
objSelection.TypeText CHR(11)

'objSelection.InlineShapes.AddPicture(strLogo)

objSelection.Font.Color = RGB (34, 139, 34)
objSelection.Font.Bold = False
objSelection.TypeText strGreen

Set objSelection = objDoc.Range()

objSignatureEntries.Add Signature, objSelection
objSignatureObject.NewMessageSignature = Signature
objSignatureObject.ReplyMessageSignature = Signature

objDoc.Saved = True
objDoc.Close
objWord.Quit

MsgBox "Подпись сформирована",0,"Подпись"

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const f_ASCII = 0, f_Unicode = -1, f_Default = -2
'===============================================================================
Dim SignFile
SignFile = WScript.CreateObject("WScript.Shell").ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Signatures\" & Signature & ".htm" ' подпись
Dim fso, f, ts
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(SignFile)
Set ts = f.OpenAsTextStream(ForReading, f_ASCII)

' Считываем всю подпись
Dim stroka : stroka = ts.ReadAll

' Начинаем работать с регулярными выражениями:
Dim regEx, Match, Matches   ' Create variable.
Set regEx = New RegExp   ' Create a regular expression.
regEx.IgnoreCase = True   ' Set case insensitivity.
regEx.Global = True   ' Set global applicability.

regEx.Pattern = "(?:[\S\s]{0,}?)(?:)([\S\s]{0,}?)(?:)" ' шаблон поиска:
'(разделитель)(открывающий тэг параграфа)(текст параграфа)(закрывающий тэг параграфа)
Set Matches = regEx.Execute(stroka)
  For Each Match in Matches
   'wscript.echo "HR => " & Match.SubMatches(0)
   'wscript.echo "Телефоны => " & Match.SubMatches(1)
   stroka = replace(stroka, Match.Value, Match.SubMatches(0) & Match.SubMatches(1), 1, -1, vbTextCompare)
  Next
ts.Close

Set ts = fso.CreateTextFile(SignFile, True, False)
ts.Write(stroka)
ts.Close

Подпись создаётся(даже если уже была), тэги трутся.

Теперь проблема в другом - не могу добиться чтобы даже на неочищенной от параграфов подписи был увеличенный интервал между разделителем и следующей строкой
Даже хуже - чищенная и нечищенная подписи одинаково корректно отображаются и в браузерах(IE8, Opera11, FF3.6). Ранее созданные(гарантировано глчювшие) подписи попробовал - тоже всё отлично... Возможно из-за даты

Re: VBScript: Вставка линии в документ Word

null@example.com (wooch) — Fri, 13 May 2011 08:39:42 +0000

BeS Yara пишет:

Поэкспериментировал...
С файлом в UTF-8 нормально всё работает в режиме ASCII, а f_Unicode относится не к UTF-8, а именно к Unicode(что не одно и тоже).
Что характерно для созданных аутлуком подписей:
HTML-подпись в кодировке UTF-8(EE BB BF)
TXT-подпись в кодировке UTF-16LE(FF FE)
RTF-подпись в заголовке упоимнается кодировка win-1251, но при этом сам текст похоже в одном из UTF-ов, но в начале отображаемого текста(F3 в TotalCommander, Word) выводятся BOM-символы от UTF-8
wooch, можете привести коды первых 4 байтов в файле подписи(чтобы определиться с кодировкой подписи)? Пока не могу понять что именно может не работать

Первые байты 3C 68

Re: VBScript: Вставка линии в документ Word

null@example.com (wooch) — Fri, 13 May 2011 08:26:10 +0000

Вот нашел упрощенный вариант:


Const ForReading = 1
Const ForWriting = 2

strFileName = WScript.CreateObject("WScript.Shell").ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Signatures\Signature.htm"
strOldText = ""
strNewText = " "

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFileName, ForReading)

strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, strOldText, strNewText)

Set objFile = objFSO.OpenTextFile(strFileName, ForWriting)
objFile.WriteLine strNewText
objFile.Close

Но почему то скрипт обрабатывается только если я его запускаю отдельно, если вставить в код после формирования подписи то он ее не редактирует.:(

Re: VBScript: Вставка линии в документ Word

null@example.com (BeS Yara) — Thu, 12 May 2011 07:58:03 +0000

Поэкспериментировал...
С файлом в UTF-8 нормально всё работает в режиме ASCII, а f_Unicode относится не к UTF-8, а именно к Unicode(что не одно и тоже).

Что характерно для созданных аутлуком подписей:
HTML-подпись в кодировке UTF-8(EE BB BF)
TXT-подпись в кодировке UTF-16LE(FF FE)
RTF-подпись в заголовке упоимнается кодировка win-1251, но при этом сам текст похоже в одном из UTF-ов, но в начале отображаемого текста(F3 в TotalCommander, Word) выводятся BOM-символы от UTF-8

wooch, можете привести коды первых 4 байтов в файле подписи(чтобы определиться с кодировкой подписи)? Пока не могу понять что именно может не работать

Re: VBScript: Вставка линии в документ Word

null@example.com (BeS Yara) — Thu, 12 May 2011 06:41:23 +0000

wooch, что именно и как не работает?
Файл подписи в ASCII или в UTF-8? Приведённый мной скрипт читает файл как ASCII - в юникоде он конечно ничего не найдёт.
Можете привести код и описание проблемы?

Re: VBScript: Вставка линии в документ Word

null@example.com (wooch) — Wed, 11 May 2011 13:56:35 +0000

ХЗ, но почему то не работает, буду разбираться в чем проблема

Re: VBScript: Вставка линии в документ Word

null@example.com (BeS Yara) — Wed, 11 May 2011 11:03:16 +0000

DIV-ы я не убирал - только

.
Шаблон составлен из четырёх подшаблонов, второй(

) и четвёртый(

) не нужен, поэтому не запоминается("?:")
Имелся кусок сделанной скриптом подписи(соответствующие куски заключил в скобки):


)
(

)
(
( 8(800)777-6655

) 8(916)123-4567




)
(

)

replace(stroka, Match.Value, Match.SubMatches(0) & Match.SubMatches(1), 1, -1, vbTextCompare) - просто заменяет в исходном тексте подписи тот кусок что приведён выше на склеенный из подшаблонов(без

). Т.о. убирается только один параграф за разделителем.

Для избавления от DIV(в приведённом Вами примере) нужно поменять шаблон:

regEx.Pattern = "(?:)"

И реплейс:

stroka = replace(stroka, Match.Value, Match.SubMatches(0), 1, -1, vbTextCompare)

Если нужно убирать и

, то шаблон будет выглядеть примерно так:

regEx.Pattern = "(?:[\S\s]{0,}?)(?:)([\S\s]{0,}?)(?:
)"

Реплейс оставить как в первоначальном варианте:

stroka = replace(stroka, Match.Value, Match.SubMatches(0) & Match.SubMatches(1), 1, -1, vbTextCompare)

Re: VBScript: Вставка линии в документ Word

null@example.com (wooch) — Wed, 11 May 2011 09:44:08 +0000

BeS Yara пишет:

wooch пишет:
BeS Yara пишет:
Проблема у меня наблюдается только для письма в формате HTML(в RTF такого нет, хотя там сама полоса толстая), всё что могу предложить - находить в файле с html-версией подписи этот параграф и удалять лишние тэги.
А можете подсказать как удалить лишние теги в ужее созданном документе?
Если подписи однотипные, то я бы попробовал через регулярные выражения. Примерно так(в 6-ой строке название файла подписи на своё нужно поменять):
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const f_ASCII = 0, f_Unicode = -1, f_Default = -2
'===============================================================================
Dim SignFile
SignFile = WScript.CreateObject("WScript.Shell").ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Signatures\AD4 Signature.htm" ' подпись
Dim fso, f, ts
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(SignFile)
Set ts = f.OpenAsTextStream(ForReading, f_ASCII) ' если файл в UTF-8, то f_Unicode

' Считываем всю подпись
Dim stroka : stroka = ts.ReadAll

' Начинаем работать с регулярными выражениями:
Dim regEx, Match, Matches   ' Create variable.
Set regEx = New RegExp   ' Create a regular expression.
regEx.IgnoreCase = True   ' Set case insensitivity.
regEx.Global = True   ' Set global applicability.

regEx.Pattern = "()([\S\s]{0,}?)(?:)" ' шаблон поиска:
'(разделитель)(открывающий тэг параграфа)(текст параграфа)(закрывающий тэг параграфа)
Set Matches = regEx.Execute(stroka)
  For Each Match in Matches
   'wscript.echo "HR => " & Match.SubMatches(0)
   'wscript.echo "Телефоны => " & Match.SubMatches(1)
   stroka = replace(stroka, Match.Value, Match.SubMatches(0) & Match.SubMatches(1), 1, -1, vbTextCompare)
  Next
ts.Close

Я конечно дико извиняюсь за свою тупость, но я не могу разобраться в шаблоне поиска. Подскажи как это сделать?
У меня создается вот такой код:

А нужно чтобы было:

Когда ручками убираю - все получается.

Re: VBScript: Вставка линии в документ Word

null@example.com (BeS Yara) — Tue, 10 May 2011 15:19:12 +0000

wooch пишет:

BeS Yara пишет:
Проблема у меня наблюдается только для письма в формате HTML(в RTF такого нет, хотя там сама полоса толстая), всё что могу предложить - находить в файле с html-версией подписи этот параграф и удалять лишние тэги.
А можете подсказать как удалить лишние теги в ужее созданном документе?

Если подписи однотипные, то я бы попробовал через регулярные выражения. Примерно так(в 6-ой строке название файла подписи на своё нужно поменять):


Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const f_ASCII = 0, f_Unicode = -1, f_Default = -2
'===============================================================================
Dim SignFile
SignFile = WScript.CreateObject("WScript.Shell").ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Signatures\AD4 Signature.htm" ' подпись
Dim fso, f, ts
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(SignFile)
Set ts = f.OpenAsTextStream(ForReading, f_ASCII) ' если файл в UTF-8, то f_Unicode

' Считываем всю подпись
Dim stroka : stroka = ts.ReadAll

' Начинаем работать с регулярными выражениями:
Dim regEx, Match, Matches   ' Create variable.
Set regEx = New RegExp   ' Create a regular expression.
regEx.IgnoreCase = True   ' Set case insensitivity.
regEx.Global = True   ' Set global applicability.

regEx.Pattern = "()([\S\s]{0,}?)(?:)" ' шаблон поиска:
'(разделитель)(открывающий тэг параграфа)(текст параграфа)(закрывающий тэг параграфа)
Set Matches = regEx.Execute(stroka)
  For Each Match in Matches
   'wscript.echo "HR => " & Match.SubMatches(0)
   'wscript.echo "Телефоны => " & Match.SubMatches(1)
   stroka = replace(stroka, Match.Value, Match.SubMatches(0) & Match.SubMatches(1), 1, -1, vbTextCompare)
  Next
ts.Close

Это конечно вариант черновой(набрал из заготовок и примеров в хелпе), но с подписью которую создал мой аутлук работает
Содержимое переменной stroka после цикла - оригинальный файл подписи в котором убраны тэги в первом параграфе после разделителя(естественно для той разметки, которую генерирует мой аутлук). Если формат разметки на разных версиях аутлук незначительно отличается, то можно попробовать сделать универсальный шаблон. Или заготовить по шаблону на разные версии аутлука.

P.S. Что характерно - ранее упоминал что файл подписи у меня в UTF-8, теперь выяснилось что подписи созданные скриптом(objSignatureEntries.Add) создались в ASCII
____________________________________
... немного подправил шаблон

Имя пользователя
Должность
Отделение
Телефон
Факс