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

Возможно у вас не установлен Microsoft Developer Support OLE File Property Reader 2.1 Sample

регистрилка "MSComDlg.CommonDialog":

Код: REGEDIT4

[HKEY_CLASSES_ROOT\Licenses\4D553650-6ABE-11cf-8ADB-00AA00C00905]
@="gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"

[HKEY_CLASSES_ROOT\Licenses\78E1BDD1-9941-11cf-9756-00AA00C00908]
@="yjrjvqkjlqqjnqkjvprqsjnjvkuknjpjtoun"

Parazitif
здесь не правильно
Cprop.CustomProperties.Add key, valueForKey ' Добавляем новое свойство
если надо текст добавлять то 4 надо в втором параметре.

И вообще слишком сложно всё сделали. Почитал мануал, и сделал в пару строк.

[more]
Код: Const msoPropertyTypeNumber = 1 ' Number
Const msoPropertyTypeBoolean = 2 'Boolean (Yes/No)
Const msoPropertyTypeDate = 3 ' Date
Const msoPropertyTypeString = 4 'String

Set objFile = CreateObject("DSOFile.OleDocumentProperties")
objFile.Open("test.xls")

' add Date Reviewed
objFile.CustomProperties.Add "Date Reviewed", msoPropertyTypeDate
objFile.Save

Set objProperty = objFile.CustomProperties.Item("Date Reviewed")
objProperty.Value = #5/19/2014#
objFile.Save

' add sample Text
objFile.CustomProperties.Add "Наименование", msoPropertyTypeString
objFile.Save

Set objProperty = objFile.CustomProperties.Item("Наименование")
objProperty.Value = "Круг " & Chr(34) & "B@Эскиз 1@" & objFile.Name & ".SLDPRT" & Chr(34)
objFile.Save

'read and view
For Each objProperty in objFile.CustomProperties
Wscript.Echo objProperty.Name, objProperty.Value
Next

Tilks
Ну вообще смотрится здорово! То, что надо! Только мне нужно, чтобы это работало с кучей моих файлов (просто их порядка 20 тысяч), поэтому и есть диалог выбора. Ну и соответсвенно, чтобы не прописывать каждый раз вручную имя файла.

Код: objFile.Open("test.xls")

Parazitif
Запустил наконец то на win7 64бит
[more]
Код: 'VBS
' MSComDlg.CommonDialog component registration
' w7 32bit C:\Windows\System32\cmd.exe C:\Windows\System32\regsvr32.exe C:\Windows\System32\comdlg32.ocx
' w7 64bit C:\Windows\SysWOW64\cmd.exe C:\Windows\SysWOW64\regsvr32.exe C:\Windows\SysWOW64\comdlg32.ocx
' [HKEY_CLASSES_ROOT\Licenses\4D553650-6ABE-11cf-8ADB-00AA00C00905]
' @="gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
'
' run script in w7 64bit system
' w7 64bit C:\Windows\SysWOW64\wscript.exe c:\testscript.vbs
Set objFile = CreateObject("DSOFile.OleDocumentProperties")
Set OpenDialog = CreateObject("MSComDlg.CommonDialog") ' Microsoft Common Dialog Control
FileChangedCount = 0

With OpenDialog
.DialogTitle = "Откройте нужный Вам файл(ы)"
.InitDir = "C:\"
'.Filter = "Модели Solidworks (*.sldlfp,*.sldasm)|*.sldlfp;*.sldasm" ' Расширения файлов
.Filter = "Office Documents (*.doc,*.xls)|*.doc;*.xls" ' Расширения файлов
.FilterIndex = 1
.Flags = 2621952
.MaxFileSize =32000
.ShowOpen
Filename = .Filename
End With

If (Len(OpenDialog.FileName)= 0) Then
msgbox "Файлы не выбраны!"
End If

files = Split(OpenDialog.Filename, vbNullChar)
count_files = UBound(files)
If count_files = 0 Then
    ' only one file select
    wscript.echo files(0)
    objFile.Open(files(0))
    AddCustomProperty
Else
    for i=1 to count_files
        ' multiple file select
        wscript.echo files(0) & "\" & files(i)
        objFile.Open(files(0) & "\" & files(i))
        AddCustomProperty
    next
End If
Msgbox "Выполнено." &chr(13)& "Количество обработанных файлов: "& FileChangedCount

Sub AddCustomProperty
    ' remove if already exist
    For Each objProperty in objFile.CustomProperties
    if objProperty.Name = "Наименование" Then
     objProperty.Remove
     objFile.Save
    end if
    Next
' set new properties
    objFile.CustomProperties.Add "Наименование", 4
    objFile.Save
    name = Split(objFile.Name, ".")
    Set objProperty = objFile.CustomProperties.Item("Наименование")
    objProperty.Value = "Круг " & Chr(34) & "B@Эскиз 1@" & name(0) & ".SLDPRT" & Chr(34)
    objFile.Save
    objFile.close
    FileChangedCount = FileChangedCount + 1
End Sub

Tilks
Просто аплодирую стоя, проверил, работает как надо! Спасибо вам за проявленную помощь от всего сердца.
__________________________
Если не секрет, что сделали, чтобы запустить на win7 64бит? Просто дома мурыжил комп и интернет два дня подряд, и так и не смог разобраться тогда.
Если я правильно понял текст скрипта, то это были единственные необходимые манипуляции своими руками?

Код: ' MSComDlg.CommonDialog component registration
' w7 64bit C:\Windows\SysWOW64\cmd.exe C:\Windows\SysWOW64\regsvr32.exe C:\Windows\SysWOW64\comdlg32.ocx
' [HKEY_CLASSES_ROOT\Licenses\4D553650-6ABE-11cf-8ADB-00AA00C00905]
' @="gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
'
' run script in w7 64bit system
' w7 64bit C:\Windows\SysWOW64\wscript.exe c:\testscript.vbs

Parazitif
Может стоит уже не мучать
Цитата:

MSComDlg.CommonDialog

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

AndVGri
Дак я ж говорю, что особо не силён в программировании, нашёл в своё время скрипт с похожими задачами, где-то что-то почитал, где-то что-то помогли, так и доделался скрипт.
Теперь задача поменялась, но и с ней уже благодря Tilks удалось справиться.
Где-то ж слышал девиз программиста: если это работает, то лучше не трогай и оставь как есть!)

Просто хотел разобраться как этот скрипт завести на win7 64бит..

Ребят, помогите со скриптом: есть скрипт, при запуске грохает експлорер и запускает mstsc с конфигом, при закрытии rdp, запускает его снова, дк вот, вместо перезапуска нужно чтоб машинка выключалась.
Вот скрипт:
[more=Code]Option Explicit
dim strComputer
dim wmiNS
dim wmiQuery
dim objWMIService
dim colItems
dim objItem
Dim strOUT

strComputer = "."
wmiNS = "\root\cimv2"
wmiQuery = "Select processID from win32_process where name = 'explorer.exe'"

Set objWMIService = GetObject("winmgmts:\\" & strComputer & wmiNS)
Set colItems = objWMIService.ExecQuery(wmiQuery)

For Each objItem in colItems
objItem.terminate(1)
Next
Dim lngProcessID

With WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\cimv2")
    Do
        If .Get("Win32_Process").Create( _
            """C:\Windows\System32\mstsc.exe"" C:\start.rdp""", _
            Null, Null, lngProcessID) = 0 Then
            
            .ExecNotificationQuery( _
                "SELECT * FROM __InstanceDeletionEvent WITHIN 1 WHERE " & _
                "TargetInstance ISA 'Win32_Process' AND " & _
                "TargetInstance.ProcessID = '" & CStr(lngProcessID) & "'").NextEvent
        Else
            ' Не удалось запустить процесс
            Exit Do
        End If
    Loop
End With
WScript.Quit [/more]

slime555
[more]
Код:
Option Explicit
dim strComputer, wmiNS, wmiQuery, objWMIService, colItems, objItem, objShell
Set objShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & wmiNS)
Set colItems = objWMIService.ExecQuery(wmiQuery)

strComputer = "."
wmiNS = "\root\cimv2"
wmiQuery = "Select processID from win32_process where name = 'explorer.exe'"

For Each objItem in colItems
objItem.terminate(1)
Next
Dim lngProcessID

With WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(strComputer, wmiNS)
If .Get("Win32_Process").Create( _
"""C:\Windows\System32\mstsc.exe"" C:\start.rdp""", _
Null, Null, lngProcessID) = 0 Then

.ExecNotificationQuery( _
"SELECT * FROM __InstanceDeletionEvent WITHIN 1 WHERE " & _
"TargetInstance ISA 'Win32_Process' AND " & _
"TargetInstance.ProcessID = '" & CStr(lngProcessID) & "'").NextEvent
Else
Wscript.Echo "Не удалось запустить процесс mstsc.exe"
WScript.Quit
End If
End With
objShell.Run "C:\WINDOWS\system32\shutdown.exe -s -t 0"

Tilks? спасибо, немножко не так, поправил:
[more=Code]Option Explicit

dim strComputer
dim wmiNS
dim wmiQuery
dim objWMIService
dim colItems
dim objItem
Dim strOUT
Dim objShell

strComputer = "."
wmiNS = "\root\cimv2"
wmiQuery = "Select processID from win32_process where name = 'explorer.exe'"

Set objShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & wmiNS)
Set colItems = objWMIService.ExecQuery(wmiQuery)

For Each objItem in colItems
objItem.terminate(1)
Next
Dim lngProcessID

With WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(strComputer, wmiNS)
If .Get("Win32_Process").Create( _
"""C:\Windows\System32\mstsc.exe"" C:\start.rdp""", _
Null, Null, lngProcessID) = 0 Then

.ExecNotificationQuery( _
"SELECT * FROM __InstanceDeletionEvent WITHIN 1 WHERE " & _
"TargetInstance ISA 'Win32_Process' AND " & _
"TargetInstance.ProcessID = '" & CStr(lngProcessID) & "'").NextEvent
Else
Wscript.Echo "Не удалось запустить процесс mstsc.exe"
WScript.Quit
End If
End With
objShell.Run "C:\WINDOWS\system32\shutdown.exe -s -t 0"[/more]

Подскажите, как побороть то, что при запуске скрипта посредством Psexec на удаленной windows7 машине окно обнаружения интерактивных служб. В принципе, мне нужно отправлять пользователь сообщение с определенным заголовком окна и все. Если службу отключить, то вообще нет никакой реакции.

Для ожидания завершения процесса использую такой [more=скрипт]
Do while isProcessRunning(strComputer,strProcess)
Loop

Function isProcessRunning(strComputer, strProcessName)

Dim objWMIService, strWMIQuery

strWMIQuery = "Select * from Win32_Process where name like '" & strProcessName & "'"
    
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")

If objWMIService.ExecQuery(strWMIQuery).Count > 0 then
isProcessRunning = true
Else
isProcessRunning = false
End if

End Function[/more]. На WinXP, все работает. Что нужно изменить, чтобы скрипт нормально работал на Win7х64. На Win7х64 выкидывает такую ошибку:
Source: (null)
Description: (null)
File: (null)
в строке "If objWMIService.ExecQuery(strWMIQuery).Count > 0 then"

Не верю, что никто не знает ответ на выше поставленный вопрос, есть надежда, что просто никто еще не заходил в ветку. Если вопрос очень простой, то заранее извиняюсь за дилетантство.
Вдобавок к этому вопросу, после завершения скрипта в процессах остается висеть Wmiprvse.exe. Это нормально?

Касательно предыдущего вопроса об ошибке при работе скрипта на Win7х64, эта информация не подтвердилась. Скрипт работает без ошибок. До этого проверял не я. Приношу сообществу свои извинения.

Добрый вечер друзья!

Нужна помощь.

Как проверить существует-ли гласс, задать его в переменную, вставить сюда:

"SELECT * FROM "переменная"

в зависимости от версии ОС т.е:
для Windows 7 = (переменная = OfficeSoftwareProtectionProduct)
Else
переменная = SoftwareLicensingProduct

Пример:

Код: strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM SoftwareLicensingProduct",,48)
For Each objItem in colItems
Wscript.Echo "ADActivationObjectName: " & objItem.ADActivationObjectName
Next

[more] Добрый день! Стоит задача выгрузить прайс из 1С в эксел, в каждую строку необходимо вставить гиперссылку. Прайс формируется, но гиперссылка программно из 1С не устанавливается (возможно каких то прав не хватает). Решил в книгу эксел вставить макрос и запустить его после формирования. Споткнулся на том что 1с вылетает с ошибкой вот здесь: VBComponents.Item(cntComp+1).CodeModule.InsertLines(1, Макрос).
Тогда я решил сделать шабон (пустой файл с макросом) и просто запустить его после формирования прайса, но он на команде Run зависает, в ошибку не выпадает, просто висит.
Макрос = "Sub Макрос2()
    For Each ws In ActiveWorkbook.Worksheets
        Sheets(ws.Name).Select
        iLastRow = ActiveSheet.UsedRange.Rows.Count
        For i = 13 To iLastRow
            If Len(ActiveSheet.Cells(i, 8).Value) > 0 Then
Range(""A"" & i & "":G"" & i).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    ActiveSheet.Cells(i, 8).Value    
ActiveSheet.Cells(i, 8).Value = """"
            End If
        Next i        
        Range(""A13"").Select
    Next    
    Sheets(1).Select
    'ActiveWorkbook.Save
End Sub";
Выгрузка прайса в 1С работает в фоновом задании, т.е. без интерактивного входа, процесс в диспетчере я вижу, а как открыть окно этого процесса чтобы попасть в отладчик и попытаться отследить ошибку? Я решил написать скрипт который перебирает процессы, находит нужный и подключает к нему окно. Вот скрипт:
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
i = 0
Set colProcessList = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = 'EXCEL.EXE'")
    For Each objProcess in colProcessList
        PID = objProcess.ProcessId
        If PID = 1356 Then
            MsgBox "Процесс " & objProcess.Name & " !!!. Его ID: " & PID & " Путь: " & objProcess.ActiveWorkBook.Name, 4096
        End If
    Next
Ссылку на процесс я получил, помогите, плиз, подключить окно. Может можно как то через GetObject, у меня не получилось.
[/more]

Доброе время
loban_ser
Да. Получаете версию Windows, например,

Код:
Set colItems = objWMIService.ExecQuery( _
"SELECT Version FROM Win32_OperatingSystem")
For Each objItem in colItems
Version = objItem.Version
Next

Alex_Piggy Здравствуйте.
Спасибо!

Решил.

Добрый день, Alex_Piggy! Уже не надеялся что кто то ответит. Я и использовал метод "Hyperlink", пробовал сначала из 1С, потом в макросе - не получается.

Добавлено:
Всего скорей где-то права закрыты, или в винде серверной (по умолчанию что-нибудь отключено), или в политики домена.

Доброе время, vYuriy
Все таки, при чем здесь права? Пожалуйста, поясните мысль.
И я говорил про функцию HyperLink, а не метод. Функцию, вводимую в ячейку. То есть не
ActiveSheet.Hyperlink.Add Range("A1"), "http://www.google.com", "google"
а
Range("A1").Value2 = "=ГИПЕРССЫЛКА(""http://www.google.com"",""google"")"
или
Range("A1").Value2 = "=HYPERLINK(""http://www.google.com"",""google"")"

По букве Вашего вопроса - Вам нужен код вроде

Код:
set xlApp = GetObject(, "Excel.Application")
xlApp.Visible = True

Добрый день. Спасибо за совет, функцию попробую. Подозрение на права потому что интерактивно захожу в 1С нажимаю кнопку, и у меня выгружается прайс и корректно отрабатывает макрос, т.е. работает один и тот же механизм, но в одном случае я его запускаю интерактивно, а в другом он запускается службой в фоновом режиме. У меня небольшой опыт в VB, подскажите что такое "set"? Я писал так: xlApp = GetObject(, "Excel.Application")
xlApp.Visible = True, при этом скрипт выпадал в ошибку, я так понимаю что он не может найти запущенный процесс Excel. Сейчас на 100% не уверен, не могу проверить, но всего скорей работающий процесс Excel и скрипт (который должен сделать видимым окно этого процесса) работают в разных сеансах пользователя Windows.

Всем привет, ткните в нужном направлении, необходимо проверять наличие ключа в реестре и соответственно выводить сообщение есть ли этот ключ или нет.

что то не отрабатывается как надо...


Код:
Function KeyExists(DisplayName)
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegRead(KeyName & "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\zabbix_agent_config_update\")

if err.number <> 0 then
    wscript.echo "Нет нужного ключа."
else
    wscript.echo "Есть нужный ключ."
end if

End Function

yrkrus
не понятно что за параметр DisplayName и KeyName. без них работает.

Код: call KeyExists
Function KeyExists()
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\zabbix_agent_config_update\")
if err.number <> 0 then
wscript.echo "Нет нужного ключа."
else
wscript.echo "Есть нужный ключ."
end if
End Function

yrkrus
[more=>>>]
Код: If WScript.Arguments.Count = 0 Then
    Set objShell = CreateObject("Shell.Application")
    objShell.ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " Run", , "runas", 1
Else

call KeyExists
Function KeyExists()
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
OpenKey=Inputbox("Какой раздел реестра Вы желаете проверить?", "Проверить нужный раздел реестра")
OpenKey = Replace(OpenKey, "HKCR", "HKEY_CLASSES_ROOT", 1, 1)
OpenKey = Replace(OpenKey, "HKCU", "HKEY_CURRENT_USER", 1, 1)
OpenKey = Replace(OpenKey, "HKLM", "HKEY_LOCAL_MACHINE", 1, 1)
OpenKey = Replace(OpenKey, "HKU", "HKEY_USERS", 1, 1)
OpenKey = Replace(OpenKey, "HKCC", "HKEY_CURRENT_CONFIG", 1, 1)
If OpenKey = "" Then: Wscript.Quit
WshShell.RegRead(OpenKey & "\")
If Err.number <> 0 then
Notstr = "Не существует"
Else
Notstr = "Существует"
End If
if Instr(Notstr, "Не существует") <> 0 Then
p = OpenKey
tmpString = InStrRev(p, "\")
parName = Mid(p, tmpString + 1)
sOpenKey = Replace(p, "\" & parName, "")
Key = "Это параметр: " & parName & vbNewLine & "Ключа: " & sOpenKey & vbNewLine & "Значение: " & WshShell.RegRead(OpenKey)
Wscript.echo "Ключ реестра: " & OpenKey & vbNewLine & Notstr & vbNewLine & vbNewLine & Key
Else
Wscript.echo "Ключ реестра: " & OpenKey & vbNewLine & Notstr
End if
End Function
End If

Всем доброго времени суток! Есть скрипт, сканирует юзеров в OU из AD, сверяет сегодняшнюю дату с датой его рождения(записана в поле "Описание") и в случае совпадения делает рассылку коллегам о дне рождения. Раньше все пользователи были в одном OU, теперь в этом OU созданы другие OU и юзеры внутри. Нужно, чтобы скрипт сканировал весь домен рекурсивно. Вот начальный скрипт:
[more=>>]
'=====================================================
'Вычисление текущей даты в формате 13.04
'=====================================================
if Month(now) < 10 then
    strMonth = "0"    + cStr(Month(now))
    else
    strMonth = cStr(Month(now))
end if
if (Day(now)) < 10 then
    strDay = "0"    + cStr(Day(now))
    else
    strDay = cStr(Day(now))
end if
strNow = strDay + "." + strMonth
'=====================================================
'Перебор пользователей OU
'=====================================================
Set objOU = GetObject("LDAP://OU=COMPANY,DC=DOMAIN,DC=LOCAL")
objOU.GetInfo
For Each objUser In objOU
    objUser.GetInfo
'=====================================================
'Сравнение поля Decription c текущей датой
'В случае совпадения посылаем почту всем пользователям кроме именинника
'=====================================================
    if objUser.description = strNow then
        For Each objMailUser In objOU
            if objMailUser.Name<>objUser.Name and objMailUser.mail <> "" then
                SendMail objMailUser.mail, strNow, objUser.displayname
            End if
        Next
    end if
next

sub sendMail(mailaddress, strNow, displayname)
'wscript.echo "SendMail " + mailaddress + " strNow " + strNow + " " + displayname
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "admin@domain.ru"
objEmail.To = mailaddress
objEmail.Subject = "Напоминание о дне рождения!"
objEmail.Textbody = "Сегодня, " + strNow + " день рождения у сотрудника " + displayname + "!"


objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "10.0.0.5"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "admin@domain.ru"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
objEmail.Configuration.Fields.Update
objEmail.Send
end sub
[/more]
Помогите пожалуйста!

Приветствую! Есть пару сабжей, которые не считают vbs программой. Т.е. exe, bat, com запускают, но не vbs. Каждый раз компилировать в exe не выход.
Нужен скрипт, который будучи скомпилирован в exe, запускал бы из собственной директории одноименный vbs. Например, есть 123.vbs, кладу рядом скомпилированный скрипт и переименовываю в 123.exe. При старте он должен запустить 123.vbs.
Или подскажите готовые решения.

В win XP такой код пикал системным динамиком:

Код: Set S = CreateObject("WScript.Shell")
S.Run "%comspec% /c" & Chr(7),0

bk99

Не уверен, что семерка вообще может пищать спикером.

bk99
на 64-бит win7 системе уже никак, кроме как драйвер написать. На 32-бит win7 умники меняли beep.sys от xp.

Ребят, есть решение по моему вопросу 4 поста назад?