08:20 23-01-2018
Never » Отсылка письма через outlook
strUserName = InputBox("Введите почтовый адрес","Окно ввода почты")

if (strUserName<>"") then

strTextToCB = "Этот текст засунем в буфер"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & StrTextToCB & "');close();""", 2

strHomeFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")

Set OutlookObject = CreateObject("Outlook.Application")
Set OutMail = OutlookObject.CreateItem(0)
With OutMail
.to = strUserName
.Subject = "Тема письма"
.Attachments.Add(strHomeFolder & "\Папка\Картинка.png")
.HTMLBody = "<body>" & _
"<font size=""4"" face=""Arial"">" & _
"Данное письмо сгененрировано автоматически, просьба не отвечать на него" & "<br> <br> <br>" & _
"Данный текст отсылается в теле письма в формате html" & "<br>" & _
"Картинка приаттачивается автоматом" & _
"<img src=Citrix_Receiver_001.png" & "<br>" & _
"</font>" & _
"</body>"
.Send
End With
end if
Группы: [ VBS ] [ Windows ]
Комментировать
URL • Print
12:10 04-10-2016
Never » Запросить ключ активации Windows
Dim fso, tf

Set WshShell = CreateObject("WScript.Shell")

Set fso = CreateObject("Scripting.FileSystemObject")
Set tf = fso.CreateTextFile("Winkey.txt", True)
tf.Write (ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")))
tf.Close


MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))

Function ConvertToKey(Key)
Const KeyOffset = 52
i = 28
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
x = 14
Do
Cur = Cur * 256
Cur = Key(x + KeyOffset) + Cur
Key(x + KeyOffset) = (Cur \ 24) And 255
Cur = Cur Mod 24
x = x -1
Loop While x >= 0
i = i -1
KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i -1
KeyOutput = "-" & KeyOutput
End If
Loop While i >= 0
ConvertToKey = KeyOutput
End Function
Группы: [ VBS ] [ Windows ] [ Реестр ]
Комментировать
URL • Print
09:54 05-10-2012
Never » Автоматическое создание подписи в Outlook'е.
'Подпись для писем, берет параметры из AD
On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

strZpov = "С уважением,"
strDev =

"---------------------------------------------------------------------------------------------------------------------------------------------------------

-------------------------------------------------------------------------------------------------------------------------------------------"
strPostIndex = ObjUser.postalCode
strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strweb = objuser.wWWHomePage
strgorod = objuser.l
strstreet = objuser.streetAddress
strfax = objuser.facsimileTelephoneNumber
strICQ = objUser.pager
strIntPhone = objuser.ipPhone
strMobile = objUser.mobile
strEmail = objuser.mail
strLogo = "\\server\logo.jpg"

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.ParagraphFormat.Space1
objSelection.Font.Size = "11"
objSelection.Font.Name = "Calibri"
objselection.font.color = RGB(0, 90, 139)
objSelection.TypeText strZpov & CHR(11)
objSelection.TypeText strName & CHR(11)
objSelection.Font.Size = "2"
objSelection.TypeText strDev & CHR(11)
objSelection.Font.Size = "11"
objSelection.TypeText strTitle & CHR(11)
if (strDepartment<>"") then objSelection.TypeText strDepartment & CHR(11)
objSelection.TypeText strCompany & CHR(11)
if (strPhone<>"") then objSelection.TypeText "Тел.: XXX-XXX вн." & strPhone & CHR(11)
if (strIntPhone<>"") then objSelection.TypeText "Тел.: " & strIntPhone & CHR(11)
if (strstrIntPhone<>"") then objSelection.TypeText "" & strIntPhone & CHR(11)
if (strfax<>"") then objSelection.TypeText "Факс: " & strfax & CHR(11)
if (strMobile<>"") then objSelection.TypeText "Моб.: " & strMobile & CHR(11)
objSelection.TypeText strPostIndex & ", г. " & strgorod & ", ул. " & strstreet & CHR(11)
if (strICQ<>"") then objSelection.TypeText "ICQ: " & strICQ & CHR(11)
Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, strWeb, "", "", strWeb)
hyp.Range.Font.Size = "11"
hyp.Range.Font.Name = "Calibri"
hyp.Range.Font.color = RGB(0, 90, 139)
objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.InlineShapes.AddPicture(strLogo)

Set objSelection = objDoc.Range()
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"

objDoc.Saved = True
objDoc.Close
objWord.Quit
Группы: [ VBS ] [ Windows ]
Комментировать
URL • Print
 
Закрыть