» Программирование "удобняшек" на VBScript (Часть 2)

msmih

Цитата:

как с помощью vbs проверить разрядность установленного ms office?

Я так понимаю, что интересует разрядность конкретной версии ms office?

На примере Office 2010:


Код:
Set oShell = CreateObject("WScript.Shell")

With WScript.CreateObject("Scripting.FileSystemObject")
    If oShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%") = "x86" Then
        If .FileExists("C:\Program Files\Microsoft Office\Office14\OSPP.VBS") Then
            WScript.Echo "Installed Office 2010 x86"
        Else
            WScript.Echo "Office 2010 Not Installed"
        End If
    Else
        If .FileExists("C:\Program Files\Microsoft Office\Office14\OSPP.VBS") Then
            WScript.Echo "Installed Office 2010 x64"
        Else
            If .FileExists("C:\Program Files (x86)\Microsoft Office\Office14\OSPP.VBS") Then
                WScript.Echo "Installed Office 2010 x86"
            Else
                WScript.Echo "Office 2010 Not Installed"
            End If
        End If
    End If
End With

WScript.Quit 0

Не знаю, решаема ли эта задача на VBS, но мало ли...
Ситуация такова. Есть сервак. На нём на двух разных дисках две сетевых папки.
Время от времени существует необходимость из одной папки в другую переносить некие данные, а затем в первую из второй - делать символьную ссылку на новое расположение.
Затык случился на символьных ссылках. На другом сервере была отработана технология, когда ссылка делалась на нём локально (mklink /j) и потом она прекрасно виделась и работала через сеть.
Однако на текущем сервере какая-то настройка в правах не даёт переходить по сети по таким сделаным локально ссылкам. Права все перерыли, ничего не получается.
Перерыв все возможности, попробовал на своём компе, на котором установлен Link Shell Extension, сделать ссылку вручную (контекстное меню проводника) по сети. И сделать junction получилось, и получилось перейти по ней, то есть всё работает. Но. Как автоматизировать процесс? С сетевыми путями mklink не работает. Порывшись в сети, нашёл такую статью: http://hex.pp.ua/symlink-winapi-functions.php , но мало что в ней понял. Может мне кто-нибудь помочь, если это вообще возможно?
Спасибо.

вот, пока делаю так:

Код: link: http://forum.ru-board.com/topic.cgi?forum=33&topic=11963&start=680#lt
gmt: 20000627132848

Ситуация такова. Есть сервак. На нём на двух

Цитата:

вот, пока делаю так:
Код:
link: http://forum.ru-board.com/topic.cgi?forum=33&topic=11963&start=680#lt
gmt: 20000627132848
Ситуация такова. Есть сервак. На нём на двух
Добавлено:
спасибо

Это был мне ответ? Если да - пардон, я его не понял.

Средствами vbs можно вытащить из pdf его превью?

fff222fffy1
Без вызова сторонних программ, я думаю не обойтись.

Добрый день форумчане и отличных выходных. Можете подсказать как в вбс собрать данные с названий нескольких файлов и сохранить это в блокнот,

есть несколько файлов где написано имя студента пробел имя группы, нужно имя группы в один блокнот, а имя студента в другой, это реально сделать??

Пример файлов - VasyaPupkin vk-013.txt

Требуется менять дату модификации папок.
Сделал по образцу http://zheleznov.info/change_file_date.htm
но это работает только для файлов, а для папок и ошибок не выдаёт, но и не меняет.
Может есть ещё какой-то способ?

Метод SetSecurityDescriptor() выполняется 10 секунд. Почему так долго?

Здравствуйте!
Имеется рабочий скрипт

Код:
clipboard = CreateObject("HTMLFile").parentWindow.clipboardData.getData("text")
file = "C:\1.bat"
'2 - перезапись, True - создавать, если
set oFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(file, 2, True)
ofile.WriteLine(clipboard)
ofile.Close

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

Код: ofile.WriteLine(clipboard)

fff222fffy1
Всё работает на отлично. Даже не думал, что так просто. Спасибо.

Поогите пожалуйста, нужно написать скрипт на VBScript, который будет выполнять:
1. Взять первую строку (целиком) в буфер обмена с удалением из текстового файла.
и еще
2. взять строку в буфер обмена первую с удалением из текстового файла, в строке содержатся данные 127.0.0.1:1111 , и там отрезать 127.0.0.1: оставив лишь только порт, порт скопировать в буфер обмена

Добрый день
Помогите написать скрипт такого типа.
Создаёт папки исходя из текущей даты на копмьютере в C:\dok\октябрь(имя папки месяц. создаётся папка скриптом исходя из системного

времени)\01-10(эта папка также формируется исходя из сегоднешнего числа)\ папка с менет "10" и "12" создаются просто в корне папки

01-10. В итоге должно получиться так C:\dok\октябрь\01-10\ и в неи 2 папаки 10 и 12.
И ешё проходит копирование С:\дата\01-10(папка выбирается относительно текужего числа и месяца) и всё содержимое авбранной папки

копируется в папку С:\дата\сегодня . С заменой файлов без запроса. И в конце просто скрипк выполнен.
Возможно ли такое написать на vbs.

Здравствуйте.
Выручайте, я не разберусь.
Мне подсказали скрипт, это для перезапуска USB, чтобы не было окон от cmd, но он не до конца отрабатывает.

Код: Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "devcon disable ""HID\VID_0D9F&PID_0004&REV_0002""", 0
WshShell.Run "devcon enable ""HID\VID_0D9F&PID_0004&REV_0002""", 0
Set WshShell = Nothing

cl85
попробуйте ввести третий параметр true, чтобы вторая команда начинала работать, когда первая команда закончена.
WshShell.Run "devcon disable ""HID\VID_0D9F&PID_0004&REV_0002""", 0, true
https://msdn.microsoft.com/en-us/library/d5fk67ky(v=vs.84).aspx

Добавлено:
или паузу между командами, чтобы успела выполнится первая.
WshShell.Sleep 5000

Tilks

Цитата:

параметр true

Спасибо, всё получилось.

Есть вот такой скрипт, чтобы проверить кто залогинен на удаленном компе (в домене). Как правильно его автоматизировать, чтобы он проходился по всем компам из OU=Computers, сохранял результат в лог, и при этом нормально себя чувствовал, если какой-то комп из списка недоступен в данный момент?


Код: strComputer = InputBox("Getting logged in username on remote computer." & vbCrLf & "Enter computer name:")
'Wscript.Echo "The name you entered was " & strComputer
'WScript.echo "The user name will appear in seconds!"
On Error Resume Next 'continue when an error occurs
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
Wscript.Echo "There was a problem locating the computer: " & strComputer
Wscript.quit
End If
On Error GoTo 0
Set colComputer = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer In colComputer
Wscript.Echo "Logged-in user: " & objComputer.UserName & vbCrLf & "Computer: " & strComputer
Next

В принципе, такой функцией можно проверить есть ли компьютер в сети

Код:
Function Avaible(sCompName) 'пингом проверяет доступность компьютера name в сети
    Dim objPing, objStatus, bResult
On Error Resume Next

bResult = False
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & sCompName & "'")
For Each objStatus in objPing
If Not (IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0) Then
    bResult = True: Exit For
End If
Next
Avaible = bResult
End Function

Нужна помощь.
В Outlook есть макрос


Код: Private Sub Application_Quit()
Msgbox "текст"
End Sub

[more] Добрый день!
Возможно ли сделать скрипт сортировки секций ini файла. Скрипт должен сортировать секции ini-файла (названия секции обрамляются квадратными скобками []) в алфавитном порядке, никак не затрагивая при этом строки внутри секции (в том числе и пустые). Желательно при этом сохранять комментарии перед секциями (комментарии определяются ; - точкой запятой). Поясню на примере. Было:

Код: [1]
строка 11
;комментарий к строке 12
строка 12
строка 13

;комментарий к секции 3
[3]
строка 31
строка 32

строка 33

;комментарий к секции 2

[2]
строка 21
строка 22
строка 23

Здравствуйте. Мне очень необходима возможность быстро менять разрешение в Windows с 1280х1024 на 1600х900 и обратно.

Добрый день! подскажите скрипт на vbs позволяющий отправить сообщение определенному адресату через outlook

Flatcher5615
запустите без параметров, тогда будет видна подсказка.

оутглюка нет, проверить не могу.

Посоветуйте кто хорошо разбирается, скрипт для скрытия обновлений win, но работает только при наличии сети. Как его в режиме offline заставить выполняться?
---------------------------
Dim hideupdates(18)

hideupdates(0) = "KB971033"
hideupdates(1) = "KB2882822"
hideupdates(2) = "KB2952664"
hideupdates(3) = "KB2977759"
hideupdates(4) = "KB2990214"
hideupdates(5) = "KB3021917"
hideupdates(6) = "KB3022345"
hideupdates(7) = "KB3035583"
hideupdates(8) = "KB3050265"
hideupdates(9) = "KB3065987"
hideupdates(10) = "KB3068708"
hideupdates(11) = "KB3075249"
hideupdates(12) = "KB3075851"
hideupdates(13) = "KB3080149"
hideupdates(14) = "KB3081954"
hideupdates(15) = "KB3083324"
hideupdates(16) = "KB3083710"
hideupdates(17) = "KB3088195"
hideupdates(18) = "KB3102810"

Set WSHShell = CreateObject("WScript.Shell")
Set updateSession = CreateObject("Microsoft.Update.Session")
updateSession.ClientApplicationID = "MSDN Sample Script"
Set updateSearcher = updateSession.CreateUpdateSearcher()
Set searchResult = updateSearcher.Search("IsInstalled=0 and Type='Software' and IsHidden=0")

Checkagain = "True"

For K = 0 To 18
If Checkagain = "True" Then
Checkagain = "False"
CheckUpdates
ParseUpdates
End if
Next

'Open Windows Update after remove the comment '
'WshShell.Run "%windir%\system32\control.exe /name Microsoft.WindowsUpdate"

Set objWshShell = nothing
Set WSHShell = Nothing
WScript.Quit


Function ParseUpdates 'cycle through updates
For I = 0 To searchResult.Updates.Count-1
Set update = searchResult.Updates.Item(I)
strUpdateName = update.Title
'WScript.Echo I + 1 & "> " & update.Title
For j = 0 To UBound(hideupdates)
if instr(1, strUpdateName, hideupdates(j), vbTextCompare) = 0 then
Else
strAllHidden = strAllHidden _
& vbcrlf & update.Title
update.IsHidden = True'
Checkagain = "True"
end if
Next
Next
End Function

Function CheckUpdates 'check for new updates cause Bing Desktop has 3
Set updateSession = CreateObject("Microsoft.Update.Session")
updateSession.ClientApplicationID = "MSDN Sample Script"
Set updateSearcher = updateSession.CreateUpdateSearcher()
Set searchResult = _
updateSearcher.Search("IsInstalled=0 and Type='Software' and IsHidden=0")
End Function

Подскажите, есть такой скрипт, он создает через Word подпись для Outlook 2013.
Необходимо его модифицировать т.о., чтобы получилась такая компоновка:


Где 1, 2, 3 -- гиперссылки. Насколько я понимаю единственный способ это резать картинку на 5 отдельных и на нужные назначать ссылки? Но можно ли быть уверенным в том, что между картинками не будет отступов?

И самое главное, как сделать так, чтобы картинки были одна под другой, а текст справа?



Код: On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strRegard = "Best regards,"
strBlank =""
'Получаем полное имя
strName = objUser.FullName
'Должность
strTitle = objUser.Title
'Подразделение
strDepartment = objUser.Department
'Компания
strCompany = objUser.Company
'Номер телефона
strPhone = objUser.telephoneNumber
strOffice = objUser.PhysicalDeliveryOfficeName
'Сотовый
strMobile = objUser.mobile
'Факс
'strFax = objuser.facsimileTelephoneNumber
'Получаем почтовый индекс
'strPostIndex = ObjUser.postalCode
'Город
'strCity = objuser.l
'Улица
'strStreet = objuser.streetAddress
'адрес электронной почты
strEmail = objuser.mail
'WEB страница
'strWeb = objuser.wWWHomePage
strWeb = "apsite.com"
'Логотип организации
strLogo = "C:\Program Files\Logo.png"

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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.Bold = False
'Шрифт
objSelection.Font.Name = "Arial"
'Размер
objSelection.Font.Size = "11"
'Цвет, можно указывать в десятичном или RGB формате, тогда: RGB(0, 0, 110)
objselection.font.color = RGB(0, 0, 0)

'Формат
objSelection.TypeText strRegard
objSelection.TypeText CHR(11)

'пустая строка
objSelection.Font.Size = "8"
objSelection.TypeText strBlank
objSelection.TypeText CHR(11)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Начертание шрифта
objSelection.Font.Bold = False
'Шрифт
objSelection.Font.Name = "Arial"
'Размер
objSelection.Font.Size = "11"
'Цвет, можно указывать в десятичном или RGB формате, тогда: RGB(0, 55, 110)
objselection.font.color = RGB(0, 0, 0)

'Вставляем полное имя
objSelection.TypeText strName
objSelection.TypeText CHR(11)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Начертание шрифта
objSelection.Font.Bold = False
'Шрифт
objSelection.Font.Size = "11"
'Цвет, можно указывать в десятичном или RGB формате, тогда: RGB(0, 55, 110)
objselection.font.color = RGB(0, 0, 0)
'Должность
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
'Подразделение
'''objSelection.TypeText strDepartment
'''objSelection.TypeText CHR(11)

'Наименование Компании
'objSelection.TypeText strCompany
objSelection.TypeText CHR(11)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Шрифт
'objSelection.Font.Size = "4"

'пустая строка
'objSelection.TypeText strBlank
'objSelection.TypeText CHR(11)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'ДОБОВЛЯЕМ ЛОГОТИПЫ

'логотип компании
objSelection.InlineShapes.AddPicture(strLogo)
objSelection.TypeText CHR(11)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Шрифт
'objSelection.Font.Size = "4"

'пустая строка
objSelection.TypeText strBlank
objSelection.TypeText CHR(11)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Начертание шрифта
objSelection.Font.Bold = False
'Уменьшаем размер шрифта для адреса
objSelection.Font.Size = "9"
'Цвет, можно указывать в десятичном или RGB формате, тогда: RGB(0, 55, 110)
objselection.font.color = RGB(0, 0, 0)

'Телефон
objSelection.TypeText "Tel: " & strPhone

'Телефон
If (strOffice<>"") then objSelection.TypeText " ext. " & strOffice
'objSelection.TypeText " ext. " & strOffice
objSelection.TypeText CHR(11)

'Сотовый
If (strMobile<>"") then objSelection.TypeText "Mob: " & strMobile & CHR(11)
'objSelection.TypeText " Mob: " & strMobile
'objSelection.TypeText CHR(11)


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'ДОБОВЛЯЕМ ССЫЛКИ
'Начертание шрифта
objSelection.Font.Italic = True
'Изменяем цвет для адреса электронной почты и сайта
objselection.Font.Color = RGB(0, 0, 0)

'Вставляем адрес почты
Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, "mailto:" & strEmail, , , strEmail)
hyp.Range.Font.Size = "11"
objSelection.TypeText CHR(11)

'корпоративный сайт
Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, strWeb, "", "", strWeb)
hyp.Range.Font.Size = "11"
objSelection.TypeText CHR(11)

'пустая строка
objSelection.TypeText strBlank
objSelection.TypeText CHR(11)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'ДОБОВЛЯЕМ ЛОГОТИПЫ

'логотип компании
'objSelection.InlineShapes.AddPicture(strLogo)

Set objSelection = objDoc.Range()

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

objDoc.Saved = True
objDoc.Close
objWord.Quit

Доброго времени суток.
Поиском не нашел, задача такая:

Нужно с помощью vbs скрипта определить разрешение экрана. Если оно меньше 1024x768, то запуск Proga1.exe. Если больше или равно 1024x768, то запуск Proga2.exe.

Ну.... например...

Код: Set oIE = CreateObject("InternetExplorer.Application")
With oIE
    .Navigate("about:blank")
    Do Until .readyState = 4: wscript.sleep 100: Loop
        width = .document.ParentWindow.screen.width
End With
oIE.Quit

Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell")
if Width < 1024 then
WshShell.Run("Proga1.exe")
else
WshShell.Run("Proga2.exe")
end if

Помогите пожалуйста с классами.
Интересует передача параметров при создании экземпляра.
Нашёл на этой странице пример, но неразжёванным он у меня не получается:

Цитата:

VBScript поддерживает концепцию конструктора с помощью метода Class_Initialize. Это частный (private) метод. Он не принимает параметров и вызывается автоматически при создании нового экземпляра класса. При использовании ключевого слова New вызывается метод Class_Initialize, если таковой существует.

Чтобы обойти ограничения в отношении параметров Class_Initialize, можно написать специальную функцию, например:

Код:
Function NewFoo(Param1, Param2, ...)
Dim myFoo
Set myFoo = New Foo
myFoo.attr1 = Param1
myFoo.attr2 = Param2
' ( ... дополнительные шаги инициализации ... )
Set NewFoo = myFoo
End Function

fff222fffy1

Цитата:

Или эта функция должна быть снаружи класса, а свойство надо делать открытым для присвоения, используя некий внутренний флаг первичности присвоения?

Да, т.к. нет функциональности создания экземпляра класса с параметрами.