Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | WshShell


Rambler's Top100


Counter CO.KZ


    [1] [2]

  1. Как средствами WSH получить значение нужной записи из раздела в реестре Windows ? 28.10.2010
  2. Как средствами WSH получить список последних файлов и/или электронной почты, которые были использованы при создании гиперссылок ? 15.05.2016
  3. Как средствами WSH вывести на экран диалоговое окно, которое автоматически скроется через указанное время ? 01.07.2007
  4. Как средствами WSH получить путь к текущему каталогу ? 06.01.2008
  5. Как средствами WSH получить путь к специальной папке Windows ? 01.07.2007
  6. Как средствами WSH получить значение переменной среды, а также получить список всех переменных OC ? 30.03.2011
  7. Как средствами WSH получить имя компьютера ? 01.07.2007
  8. Как средствами WSH получить имя пользователя ? 04.08.2007
  9. Как средствами WSH получить список всех принтеров ? 30.10.2010
  10. Как средствами WSH создать ярлык ? 17.07.2007
  11. Как средствами WSH создать URL ярлык ? 20.07.2007
  12. Как средствами WSH определить файл, на который указывает ярлык, а также узнать существует ли этот файл ? 20.06.2016
  13. Как найти в определённой папке все ярлыки .lnk, а затем, проверить их корректность (WSH) ? 20.06.2016
  14. Как средствами WSH запустить нужное приложение и дождаться его завершения ? 01.05.2008
  15. Как сделать так, чтобы после включения компьютера, Excel запускался автоматически ? 08.01.2008
    [1] [2]


  • Ответ : Скачать файл

    Для того, чтобы получить значение нужной записи из раздела в реестре Windows, можно воспользоваться методом RegRead, учитывая, что в случае неправильного указания раздела, Вы получите ошибку (пример получения шрифта, используемого в VBE прилагается)
  • iFontFace = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\VBA\Office\FontFace")

    MsgBox "В редакторе VBA используется шрифт : " & iFontFace
    Примечание : Эта ветка в реестре была найдена на компьютере, где была установлена одна единственная версия офиса. Вполне возможно, что на других компьютерах, с другими версиями операционной системы и офиса, она будет другой и Вы получите ошибку.
  • Ответ :
  • CreateObject("WScript.Shell").Popup _ 
    "Это окно скроется через пять секунд", 5, "Microsoft Excel", 48
    При необходимости, можно указать необходимый тип значка и кнопок, а также определить какая из кнопок была нажата, например :
    Select Case CreateObject("WScript.Shell").Popup( _ 
        "Вы хотите продолжить работу ?", 10, _ 
        "Сделайте свой выбор за 10 секунд", 3 + 32) 
        Case 6: MsgBox "Вы выбрали Да", , "" 
        Case 7: MsgBox "Вы выбрали Нет", , "" 
        Case 2: MsgBox "Вы выбрали Отмена/Закрыть", , "" 
        Case Else: MsgBox "Вы отказались от выбора", , "" 
    End Select

  • Ответ :
  • iCurDir = CreateObject("WScript.Shell").CurrentDirectory
    Комментарий : Обратите внимание на то, что существует, как минимум, два способа определения текущего каталога, причём, используя только средства Excel.
  • Ответ :
  • For Each iFolder In CreateObject("WScript.Shell").SpecialFolders 
        MsgBox "Путь : " & iFolder, vbExclamation, "" 
    Next
    Ниже приведён список имён, позволяющих получить путь к нужной папке, а также пример получения пути к папке "Рабочий стол". Список составлен на основании материалов изложенных в MSDN : SpecialFolders Property

  • AllUsersDesktop
  • AllUsersStartMenu
  • AllUsersPrograms
  • AllUsersStartup
  • Desktop
  • Favorites
  • Fonts
  • MyDocuments
  • NetHood
  • PrintHood
  • Programs
  • Recent
  • SendTo
  • StartMenu
  • Startup
  • Templates
  • iPathDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    

  • Ответ :

    Для того, чтобы средствами WSH получить значение переменной среды можно использовать либо свойство Environment (вариант I), либо метод ExpandEnvironmentStrings (вариант II)

    Вариант I.
  • Dim iWshShell As Object 
    Set iWshShell = CreateObject("WScript.Shell") 
    
    iTemp = iWshShell.Environment.Item("TEMP") 
    iOS = iWshShell.Environment("System")("OS") 'WinNT/2000/XP 
    iProgramFile = iWshShell.Environment("Process")("ProgramFiles")
    
    Комментарий : Обратите внимание на то, что у свойства Environment есть необязательный аргумент Type, который, собственно, и позволяет указать необходимый тип, например, "Process", "System", "User", "Volatile". Если же Вы проигнорируете этот аргумент (см. самый первый пример), то в таком случае тип будет определяться исходя из версии Windows (в Win95/98/Me - "Process", а в WinNT/2000/XP - "System")

    Для получения списка всех доступных переменных среды Вашей операционной системы, можно воспользоваться нижеопубликованным макросом, только учтите, что пример предназначен для WinNT/2000/XP, т.к. согласно MSDN : Environment Property в Win95/98/Me единственно возможный тип, это "Process"
    Dim iWshShell As Object 
    Set iWshShell = CreateObject("WScript.Shell") 
    For Each iWshEnviron In Array("Process", "System", "User", "Volatile") 
        For Each iVariable In iWshShell.Environment(iWshEnviron) 
            iRow& = iRow& + 1 
            Cells(iRow&, 1) = iWshEnviron 
            Cells(iRow&, 2) = "'" & iVariable 
        Next 
    Next
    Вариант II.
    Dim iWshShell As Object 
    Set iWshShell = CreateObject("WScript.Shell") 
    
    iTemp = iWshShell.ExpandEnvironmentStrings("%TEMP%") 
    iOS = iWshShell.ExpandEnvironmentStrings("%OS%") 
    iProgramFile = iWshShell.ExpandEnvironmentStrings("%ProgramFiles%")
    
    Комментарий : Обратите внимание на то, имя переменной обязательно должно быть заключено между двумя % , если же Вы забудете добавить эти символы, то в результате просто получите имя переменной.
  • Ответ :
  • MsgBox "Имя компьютера : " & CreateObject("WScript.Network").ComputerName
    
    MsgBox "Имя компьютера : " & _ 
    CreateObject("WScript.Shell").Environment("Process")("ComputerName")
    

  • Ответ :
  • MsgBox "Имя пользователя : " & CreateObject("WScript.Network").UserName
    
    MsgBox "Имя пользователя : " & _ 
    CreateObject("WScript.Shell").Environment("Process")("UserName")
    

  • Ответ :

    Для того, чтобы получить следующие сведения (имя и порт) о всех принтерах можно воспользоваться следующим примером :
  • With CreateObject("WScript.Network").EnumPrinterConnections
         For i = 0 To .Length - 1 Step 2
             MsgBox _
             "Имя принтера : " & .Item(i) & vbNewLine & _
             "Порт принтера : " & .Item(i + 1), , ""
         Next
    End With
    Важно : Данный способ предназначен для WinXP, в предыдущих версиях он позволяет получить список только сетевых принтеров.

    Источник : Sources.ru | FAQ
  • Ответ :

    Пример создания ярлыка на рабочем столе - для Microsoft Excel
  • With CreateObject("WScript.Shell")
         With .CreateShortcut(.SpecialFolders("Desktop") & "\Excel.lnk")
              .TargetPath = Application.Path & "\EXCEL.EXE"
              .Description = "Проба пера" 'необязательно
              .Save
         End With
    End With

  • Ответ :

    Пример создания URL ярлыка, который будет находиться в папке Избранное и ссылаться на этот сайт
  • Private Sub WSH_CreateURLShortcut()
        With CreateObject("WScript.Shell")
             With .CreateShortcut(.SpecialFolders("Favorites") & _
             "\Microsoft Excel Вопросы и Ответы Советы Примеры.url")
                  .TargetPath = "http://www.msoffice.nm.ru"
                  .Save
             End With
        End With
    End Sub
    Комментарий : Обратите внимание на то, что папку Избранное, гарантировано использует только браузер Internet Explorer
  • Ответ :

    Пример того, как средствами WSH определить имя файла, на который указывает ярлык. А также узнать, не был ли этот файл удалён/перемещён/переименован.
  • Private Sub WSH_GetTargetFileName()
        Dim iFileName$
        iFileName = "C:\Мои документы\Ярлык.xls.lnk"
    
        iFileName = CreateObject("WScript.Shell").CreateShortcut(iFileName).TargetPath
        If Dir(iFileName) <> "" Then
           MsgBox iFileName, , "Местонахождение файла"
        Else
           MsgBox "Об'ект был удалён/переименован/перемещён", vbCritical , ""
        End If
    End Sub
    Комментарий : В данном примере, ярлык необходимо указывать реально существующий, однако, это может быть и URL ярлык.
  • Ответ :

    Пример того, как в указанной папке, можно найти все ярлыки .lnk, а затем, проверить не были ли удалены/перемещены/переименованы файлы, на который указывают найденные ярлыки.
  • Private Sub FindInvalidShortCut()
        Dim iPath$, iFileName$, iCount&
        Dim iCollection As New Collection
    
        iPath = "C:\Имя_папки_с_ярлыками\" 'Укажите свою папку
        iFileName = Dir(iPath & "*.lnk")
    
        Do Until iFileName = ""
           iCollection.Add iPath & iFileName
           iFileName = Dir
        Loop
        
        With CreateObject("WScript.Shell")
             For iCount = 1 To iCollection.Count
                 iFileName = .CreateShortcut(iCollection(iCount)).TargetPath
                 If Dir(iFileName) = "" Then
                    MsgBox iFileName, vbCritical, "Битый ярлык"
                 Else
                    MsgBox iFileName, vbInformation, "Нормально"
                 End If
             Next
        End With
    End Sub
    Private Sub FindInvalidShortCut2()
        Dim iPath$, iFileName As Variant
        Dim iCollection As New Collection
    
        iPath = "C:\Имя_папки_с_ярлыками\" 'Укажите свою папку
        iFileName = Dir(iPath & "*.lnk")
    
        If Len(iFileName) = 0 Then MsgBox _
        "Ни одного ярлыка не обнаружено", vbCritical, "": Exit Sub
    
        Do
             iCollection.Add iPath & iFileName
             iFileName = Dir
        Loop Until Len(iFileName) = 0 
        
        With CreateObject("WScript.Shell")
             For Each iFileName In iCollection
                 iFileName = .CreateShortcut(iFileName).TargetPath
                 If Len(Dir(iFileName)) = 0 Then
                    MsgBox iFileName, vbCritical, "Битый ярлык"
                 Else
                    MsgBox iFileName, vbInformation, "Нормально"
                 End If
             Next
        End With
    End Sub

  • Ответ :

    Пример запуска стандартного калькулятора Windows, активации окна, и отслеживание состояния запущенного приложения.
  • Private Sub WSH_ExecuteApp()    
        Dim iWshShell As Object, iWshExec As Object
        
        Set iWshShell = CreateObject("WScript.Shell")
        Set iWshExec = iWshShell.Exec("Calc.exe")
        
        iProcessID& = iWshExec.ProcessID
        If iProcessID& = 0 Then
           MsgBox "Не удалось выполнить планируемое", , ""
        Else
           iWshShell.AppActivate iProcessID&
           Do
                'iWshExec.Terminate
                'Если понадобится завершить работу с запущенным приложением
           Loop While iWshExec.Status = 0
           MsgBox "Вы закончили работу с калькулятором", , ""
        End If    
    End Sub
    Private Sub WSH_ExecuteApp2()
        CreateObject("WScript.Shell").Run "Calc.exe", 1, True
        
        MsgBox "Вы закончили работу с калькулятором", , ""
    End Sub

  • Ответ :

    Подобную задачу вполне можно решить и без использования макросов [], однако, если это действительно необходимо, то об'единив ответы на два предыдущих вопроса, можно получить :
  • Private Sub Excel_AutoExecute()
        With CreateObject("WScript.Shell")
             With .CreateShortcut(.SpecialFolders("StartUp") & "\Excel.lnk")
                  .TargetPath = Application.Path & "\EXCEL.EXE"
                  .Save
             End With
        End With
    End Sub

    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2018 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff