Перейти из форума на сайт.

Новости • Файловые архивы
Поиск • Активные темы • Топ лист
Правила • Кто в on-line?
Вход • Забыли пароль? • Первый раз на этом сайте? • Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript

Модерирует : ShIvADeSt

ShIvADeSt (12-07-2011 15:12): http://forum.ru-board.com/topic.cgi?forum=33&topic=11963#1  Версия для печати • Подписаться • Добавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

   

MoonGod

Newbie		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

Цитата:
Чего специфичного то? Есть системная переменная возвращающая папку пользователя  %HOMEPATH%.  
http://www.windowsfaq.ru/content/view/263/

 
спасибо, думаю USERPROFILE будет лучше + попрыгаю еще от Win32_OperatingSystem чтоб определить какая винда и сделать правильный путь
Всего записей: 22 | Зарегистр. 21-06-2006 | Отправлено: 05:08 20-08-2010 | Исправлено: MoonGod, 05:09 20-08-2010
MoonGod

Newbie		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Сделал нужный мне скрипт, возник следующий вопрос - при выполнении скрипта постоянно пищит биппер (обнаружил после тестирование на другом компе). Есть ли возможность его отключить через скрипт?
Всего записей: 22 | Зарегистр. 21-06-2006 | Отправлено: 18:09 21-08-2010 | Исправлено: MoonGod, 19:39 21-08-2010
vivasem



Newbie		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
С неособым трудом нашел скрипт удаляющий старые файлы в поддиректориях, но для полного удобства не хватает одной функции - не трогать файлы, если их количество менее 5-ти в одной папке. Если Вам не трудно, поправьте скрипт ибо Я и VBS полный нюб... Только начинаю bat осваивать.
 
 

Код:
 
path = "D:\Backup"
     
    killdate = date() - 30
     
    arFiles = Array()
    set fso = createobject("scripting.filesystemobject")
     
    ' True - для поиска и по поддиректориям тоже, False - только в самой директории
    SelectFiles path, killdate, arFiles, true
     
    nDeleted = 0
    for n = 0 to ubound(arFiles)
      on error resume next 'in case of 'in use' files...
      arFiles(n).delete true
      if err.number <> 0 then
      else
        nDeleted = nDeleted + 1
      end if
      on error goto 0
    next
     
    sub SelectFiles(sPath,vKillDate,arFilesToKill,bIncludeSubFolders)
      on error resume next
      set folder = fso.getfolder(sPath)
      set files = folder.files
     
      for each file in files
        dtlastmodified = null
        on error resume Next
        dtlastmodified = file.datelastmodified
        on error goto 0
        if not isnull(dtlastmodified) Then
          if dtlastmodified < vKillDate then
            count = ubound(arFilesToKill) + 1
            redim preserve arFilesToKill(count)
            set arFilesToKill(count) = file
          end if
        end if
      next
     
      if bIncludeSubFolders then
        for each fldr in folder.subfolders
          SelectFiles fldr.path,vKillDate,arFilesToKill,true
        next
      end if
    end sub
Всего записей: 6 | Зарегистр. 23-08-2010 | Отправлено: 16:39 23-08-2010
Rush

Уже за тридцать...		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
vivasem

Код:
path = "D:\Backup"
 
    killdate = date() - 30
 
    arFiles = Array()
    set fso = createobject("scripting.filesystemobject")
 
    ' True - для поиска и по поддиректориям тоже, False - только в самой директории
    SelectFiles path, killdate, arFiles, true
 
    nDeleted = 0
    for n = 0 to ubound(arFiles)
      on error resume next 'in case of 'in use' files...
      arFiles(n).delete true
      if err.number <> 0 then
      else
        nDeleted = nDeleted + 1
      end if
      on error goto 0
    next
 
    sub SelectFiles(sPath,vKillDate,arFilesToKill,bIncludeSubFolders)
      on error resume next
      set folder = fso.getfolder(sPath)
      set files = folder.files
       
    if files.count > 4 then  
      for each file in files
        dtlastmodified = null
        on error resume Next
        dtlastmodified = file.datelastmodified
        on error goto 0
        if not isnull(dtlastmodified) Then
          if dtlastmodified < vKillDate then
            count = ubound(arFilesToKill) + 1
            redim preserve arFilesToKill(count)
            set arFilesToKill(count) = file
          end if
        end if
      next
    end if
 
      if bIncludeSubFolders then
        for each fldr in folder.subfolders
          SelectFiles fldr.path,vKillDate,arFilesToKill,true
        next
      end if
    end sub
Всего записей: 3551 | Зарегистр. 20-11-2003 | Отправлено: 19:06 23-08-2010
vivasem



Newbie		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Rush
Спасибо огромное!!! Вот наконец закончил собирать пакет скриптов для автоматизации резевного копирования. Если кому нужно, это ТУТ
Всего записей: 6 | Зарегистр. 23-08-2010 | Отправлено: 13:32 24-08-2010
NIKO71

Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Господа, плз, помогите новичку.
Есть вот такой скрипт создающий подпись в Outlook:
 

Код:
 
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
 
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
 
strRegard = "С уважением,"
'Получаем полное имя
strName = objUser.FullName
'Должность
strTitle = objUser.Title
'Подразделение
'strDepartment = objUser.Department
'Компания
strCompany = objUser.Company
'Номер телефона
strPhone = objUser.telephoneNumber
'Сотовый
strMobile = objUser.mobile
'Факс
strFax = objuser.facsimileTelephoneNumber
'IP-телефон, у себя не использую, так как внутренний номер дописываю в поле основного телефона
strIntPhone = objuser.ipPhone
'Получаем почтовый индекс
strPostIndex = ObjUser.postalCode
'Город
strCity = objuser.l
'Улица
strStreet = objuser.streetAddress
'адрес электронной почты
strEmail = objuser.mail
'WEB страница
strWeb = objuser.wWWHomePage
'Логотип организации
'strLogo = "\\domain.corp\NETLOGON\company-logo.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 = "Arial"
'Размер
objSelection.Font.Size = "10"
'Цвет, можно указывать в десятичном или RGB формате, тогда: RGB(0, 55, 110)
objSelection.Font.Color = RGB(0,0,0)
'Формат
objSelection.ParagraphFormat.Space1
 
objSelection.TypeText strRegard
objSelection.TypeText CHR(11)
'Вставляем полное имя
objSelection.Font.bold=true
objSelection.TypeText strName
objSelection.TypeText CHR(11)
objSelection.Font.bold=false
'Должность
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
'Подразделение
'objSelection.TypeText strDepartment
'objSelection.TypeText CHR(11)
'Компанию
objSelection.TypeText strCompany
objSelection.TypeText CHR(11)
'Уменьшаем размер шрифта для адреса
'objSelection.Font.Size = "9"
'Почтовый адрес
'objSelection.TypeText strPostIndex & ", г. " & strCity & ", " & strStreet
'objSelection.TypeText CHR(11)
'Телефон
objSelection.TypeText "Тел.:  " & strPhone & " доб." & strIntPhone
objSelection.TypeText CHR(11)
'Сотовый
'objSelection.TypeText "Моб. " & strMobile
'objSelection.TypeText CHR(11)
'Факс
objSelection.TypeText "Факс: " & strFax
objSelection.TypeText CHR(11)
'Вставляем адрес почты
objSelection.TypeText "mail to: "
'Изменяем цвет для адреса электронной почты и сайта
objselection.font.color = RGB(0, 0, 255)
Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail)
hyp.Range.Font.Size = "10"
hyp.Range.Font.Name = "Arial"
objSelection.TypeText CHR(11)
'корпоративный сайт
Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, strWeb, "", "", strWeb)
hyp.Range.Font.Size = "10"
hyp.Range.Font.Name = "Arial"
'objSelection.Hyperlinks.Add objSelection.Range, strWeb, "", "", strWeb
'objSelection.TypeText CHR(11)
'логотип компании
'objSelection.InlineShapes.AddPicture(strLogo)
 
Set objSelection = objDoc.Range()
 
objSignatureEntries.Add "Company Signature", objSelection
objSignatureObject.NewMessageSignature = "Company Signature"
objSignatureObject.ReplyMessageSignature = "Company Signature"
 
objDoc.Saved = True
objDoc.Close
objWord.Quit
 

 
В данном случае данные берутся из АД.
А как сделать чтобы данные брались из обычного Excel-ого файла?
Т.е. есть файл *.xls  
Допустим 4 колонки: ФИО, Должность, E-mail, тел. (доб).
Ну и соответственно, при обработке этого скрипта данные должны браться не из АД, а из этого файла.
Всего записей: 35 | Зарегистр. 05-02-2004 | Отправлено: 17:31 24-08-2010
PulsSe

Newbie		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Ребят, Кто знает как автоматизировать процесс смены буквы флешки через diskmgmt.msc через батник? суть такая, втыкаю флэшку, выполняется авторун, авторун выполняет батник, а батник должен сменить букву флешки на ту, которую мне нужно..
 
можно как нить по другому автоматизировать этот процесс, главно не как, а главное что бы работало.. помогите плиз как сделать) если можно то поподробнее
Всего записей: 28 | Зарегистр. 31-08-2010 | Отправлено: 16:41 03-09-2010
Scaramanga



Full Member		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Всем привет.  
Начал тут VB изучать. Застопорился на таком моменте.  
Есть переменная "NameComp" Если прописываю прямо
 

Код:
Dim NameComp
NameComp = "тут руками пишу имя компа"

 
Скрипт работает как надо. Как сделать так чтобы имя компа определялось и прописывалось автоматом?
Пробую так  

Код:
NameComp = InputBox(strComputer)

 
Просит ввести имя компа и дальше нормально продолжает работать.

Код:
NameComp=Environ("ComputerName

так отрабатывает тихо без ошибок но нет результата
 
 Подскажите как сделать чтоб на автомате все было)
Всего записей: 516 | Зарегистр. 24-04-2008 | Отправлено: 22:51 08-09-2010 | Исправлено: Scaramanga, 23:27 08-09-2010
Rush

Уже за тридцать...		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Scaramanga

Код:
 
Dim NameComp, WshShell
Set WshShell = CreateObject("WScript.Shell")  
NameComp = WshShell.ExpandEnvironmentStrings("%ComputerName%")
 

 
Добавлено:
или так:

Код:
 
Dim NameComp, WshNW
Set WshNW = CreateObject("WScript.Network")
NameComp = WshNW.ComputerName
 
Всего записей: 3551 | Зарегистр. 20-11-2003 | Отправлено: 23:59 08-09-2010
Scaramanga



Full Member		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Огромное спасибо
Всего записей: 516 | Зарегистр. 24-04-2008 | Отправлено: 00:09 09-09-2010
Free_Soft



Advanced Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Доброго времени суток!
Есть код:

Код:
On Error Resume Next
 
Dim Args, WshShell, BtnCode, strText, strTitle, nSecondsToWait, nType
 
Set Args=WScript.Arguments
Set WshShell=WScript.CreateObject("WScript.Shell")
 
If Args.Count<4 Or Args.Count>5 Then WScript.Quit(255)
strText=Args(0)
strTitle=Args(1)
If Args.Count=5 Then nSecondsToWait=Args(4) Else nSecondsToWait=0
 
nType=0
Select Case UCase( Left(Args(2), 1) )
    case "W" nType=16
    case "Q" nType=32
    case "E" nType=48
    case "I" nType=64
End Select
 
Select Case UCase( Args(3) )
    case "OK" nType=nType+0
    case "OKCANCEL" nType=nType+1
    case "ABORTRETRYIGNORE" nType=nType+2
    case "YESNOCANCEL" nType=nType+3
    case "YESNO" nType=nType+4
    case "RETRYCANCEL" nType=nType+5
End Select
 
WScript.Quit( WshShell.Popup(strText, nSecondsToWait, strTitle, nType) )

это аналог консольной утилиты MsgBox для вывода сообщений на экран. Как можно сюда добавить перенесение строк? если можно, использовать для этого символ [`] и [``] для вставки пустой строки. (символы на кнопке с буквой Ё).. Ну или как-то еще.
Заранее признателен за помощь
Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 09:56 09-09-2010 | Исправлено: Free_Soft, 10:27 09-09-2010
ComradG



Silver Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Free_Soft

Код:
"" & Chr(10) & "Blah-blah-blah"

Это имел в виду? Chr(10) - это символ переноса на новую строку.
Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 11:36 09-09-2010
Free_Soft



Advanced Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ComradG
Т.е. Это не в код вставлять а в строку синтаксиса?
Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 11:46 09-09-2010
ComradG



Silver Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Free_Soft
Тебе же нужно строки разбивать, так ведь? Вот, допустим у тебя есть строка: "Never trust a pinguin, dude!" Нужно, чтобы "pinguin, dude!" оказалось на следующей строке. Тогда пишешь:

Код:
"Never trust" & Chr(10) & "a pinguin, dude!"

Или тебе нужно переносить строки в самом коде?
Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 11:54 09-09-2010
Free_Soft



Advanced Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
нет, в сообщении. А чтобы пустую строку вставить просто пробел в кавычках набить?
Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 11:59 09-09-2010
ComradG



Silver Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Free_Soft
Ага.
Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 12:02 09-09-2010 | Исправлено: ComradG, 12:03 09-09-2010
Free_Soft



Advanced Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ComradG
Пасиб.
 
Добавлено:
а можно как то выделять кнопки по умолчанию?
Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 12:06 09-09-2010
ComradG



Silver Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Free_Soft
Наверное можно, ведь это ж по сути перманентный Бэйсик. Как, если честно, не знаю, не сталкивался с оным. Но можно попробовать потыкать в сторону свойств элементов формы, например, IsDefault или чего-то в этом роде. А чтобы не гадать на кофейной гуще, лучше заглянуть на msdn (описание VBSсript'а)
Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 13:11 09-09-2010 | Исправлено: ComradG, 13:19 09-09-2010
Free_Soft



Advanced Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ComradG
сейчас попробовал
Код:
"Never trust" & Chr(10) & "a pinguin, dude!"

не работает. запускаю из консоли так:
Код:
cscript //nologo msgbox.vbs "Never trust" & Chr(10) & "a pinguin, dude!" "My Script" w OK 30

консоль отвечает

Код:
'Chr' is not recognized as an internal or external command,
operable program or batch file.
The filename, directory name, or volume label syntax is incorrect.
Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 18:05 09-09-2010
Scaramanga



Full Member		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Всем привет.  
Есть код создает zip архив и добавляет в него нужный файл

Код:
Set FileSytemObject = CreateObject("Scripting.FileSystemObject")
SourceFilePath = "c:\eventlogs.csv"
DestFilePath = "c:\EventLogs.zip"
Set Zip = New ZipClass
Zip.CreateArchive DestFilePath
Zip.CopyFileToArchive SourceFilePath
Zip.CloseArchive
 
MsgBox "Архив создан на рабочем столе", vbInformation, "Операция завершена"
 
Class ZipClass
    Private Shell
    Private FileSystemObject
    Private ArchiveFolder
    Private ItemsCount
 
    Private Sub Class_Initialize()
        Set Shell = CreateObject("Shell.Application")
        Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    End Sub  
 
    Function CreateArchive(ZipArchivePath)
        If UCase(FileSystemObject.GetExtensionName(ZipArchivePath)) <> "ZIP" Then
            Exit Function
        End If
 
        Dim ZipFileHeader
        ZipFileHeader = "PK" & Chr(5) & Chr(6) & String(18, 0)
        FileSystemObject.OpenTextFile(ZipArchivePath, 2, True).Write ZipFileHeader
        Set ArchiveFolder = Shell.NameSpace(ZipArchivePath)
        If Not (ArchiveFolder is Nothing) Then CreateArchive = True
    End Function  
 
    Function CopyFileToArchive(FilePath)
        If (ArchiveFolder Is Nothing) Then Exit Function
        ArchiveFolder.CopyHere FilePath
        ItemsCount = ItemsCount + 1
    End Function  
 
    Function CopyFolderToArchive(FolderPath)
        If (ArchiveFolder Is Nothing) Then Exit Function
        ArchiveFolder.CopyHere FolderPath
        ItemsCount = ItemsCount + 1
    End Function  
 
    Function CloseArchive
        If (ArchiveFolder is Nothing) Then Exit Function
        Set WsriptShell = CreateObject("Wscript.Shell")
        If IsObject(Wscript) Then
            Do
                Wscript.Sleep 100
            Loop Until ArchiveFolder.Items.Count => ItemsCount
        Else
            ServerSleep
        End if
        ItemsCount = 0
    End Function
 
    Private Function ServerSleep
        Set WsriptShell = CreateObject("Wscript.Shell")
        Do
            WsriptShell.Popup "", 1, ""
        Loop Until ArchiveFolder.Items.Count => ItemsCount
    End Function
 
    Function MoveFileToArchive(FilePath)
        If (ArchiveFolder is Nothing) Then Exit Function
        ArchiveFolder.MoveHere FilePath
    End Function
End Class

 
Сам по себе работает отлично. Копирую его в основной скрипт и все, архивирование не проходит.  
 
 
Полный код тут. Отрабатывает весь скрипт кроме архивирования.
Всего записей: 516 | Зарегистр. 24-04-2008 | Отправлено: 20:14 09-09-2010
   

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript
ShIvADeSt (12-07-2011 15:12): http://forum.ru-board.com/topic.cgi?forum=33&topic=11963#1


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru