Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)
-   -   создание папки с текущей датой, помогите подправить для текстового файла (http://forum.oszone.net/showthread.php?t=342404)

balzaman 01-10-2019 20:51 2890396

создание папки с текущей датой, помогите подправить для текстового файла
 
здравствуйте
---
есть скрипт - create a folder with the date and open her.vbs
---
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim fldr

one=date 'получаем текущую дату
one=Mid(one,1,4)&Mid(one,6,2)&Mid(one,9,2) 'удаляем точки 2019.10.01 = 20191001 (если нужен оригинал убираем эту строку), (если нужна модификация вашего формата - корректируем значения "Mid" - логика отображения № сивола и количество знаков от этого номера вправо)

' наше название папки (текущая дата - по умолчанию)
result = InputBox("введите имя","создание папки",one)


if Not IsEmpty(result) then ' если не нажата отмена то делаем:
Set fldr=FSO.CreateFolder ("" & result) ' создаем папку с датой и нашим названием
WshShell.Run "Explorer " & """" & fldr & """" ' открываем папку в проводнике
WshShell.Run "cmd.exe /c echo "&result&"| clip", 0, TRUE 'копируем в буфер название папки
End if
WScript.Quit ' пути windows неисповедимы
---
помогите пожалуйста подправить скрипт vbs
чтобы вместо папки, создавать например текстовой файл, или RTF - Rich Text Format
заранее благодарю
---
в принципе, для чего это надо мне
есть модификатор проводника - qttabbar (очень крутая штука)
но, у меня версия os - windows xp
на новых системах я не пробовал
кому интересно, можете скачать дополнение с инструкциями
загрузить архив здесь не вышло (выдаёт ошибку объёма, архив весит 5 мб)
вот ссылка с гуглодиска
https://drive.google.com/open?id=1kZ...7u0JViZVA9zAW_

Iska 01-10-2019 21:14 2890399

Цитата:

Цитата balzaman
в принципе, для чего это надо мне »

Опишите словами, что Вам надо (забыв про имеющийся скрипт).

Цитата:

Цитата balzaman
есть модификатор проводника - qttabbar (очень крутая штука) »

Очень на любителя.

balzaman 01-10-2019 23:00 2890405

нужно, чтобы скрипт выполнял следующие действия:
---
создание документа, например .txt, или .rtf
с вызовом диалогового окна, для внесения имени
в окне автоматом прописывается текущая дата (именно это интересно)
жмём OK и файл открывается
всё в принципе
---
попробуйте запустить скрипт из темы
там всё наглядно будет понятно
---
скрипты без вставки даты у меня есть (и каталог и блокнот)
http://forum.oszone.net/thread-202807.html
надо с авто вставкой текущей даты

Iska 01-10-2019 23:42 2890409

Пробуйте (без проверок):
Скрытый текст
Код:

Option Explicit

Dim strSourceFile


With WScript.CreateObject("Scripting.FileSystemObject")
        strSourceFile = Trim(InputBox("Enter file name:", "Enter file name", .GetAbsolutePathName(GetLocalDate() & ".txt")))
       
        If Not .FileExists(strSourceFile) Then
                .CreateTextFile(strSourceFile).Close
                WScript.CreateObject("Shell.Application").NameSpace(.GetParentFolderName(strSourceFile)).ParseName(.GetFileName(strSourceFile)).InvokeVerb "open"
        End If
End With

WScript.Quit 0

Function GetLocalDate()
        Dim objSWbemObjectEx
       
        For Each objSWbemObjectEx In WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\cimv2").ExecQuery("SELECT LocalDateTime FROM Win32_OperatingSystem WHERE Primary = 'True'")
                GetLocalDate = Left(objSWbemObjectEx.LocalDateTime, 8)
               
                Exit For
        Next
End Function


balzaman 02-10-2019 00:31 2890416

да работает - прописывает полный путь
при длинном пути всё нормально
показывает хвост адереса
благодарю
---
но, при отмене создания файла, возникает ошибка
---------------------------
Windows Script Host
---------------------------
Сценарий: C:\Program Files\qttabbar_source\qttabbar_launcherbutton_new_text.vbs
Строка: 10
Символ: 3
Ошибка: Недопустимый вызов или аргумент процедуры
Код: 800A0005
Источник: Ошибка выполнения Microsoft VBScript

---------------------------
ОК
---------------------------
---
пардон за беспокойство
а можно такой же скрипт
для создания каталога (папки)

Iska 02-10-2019 00:59 2890417

Цитата:

Цитата balzaman
но, при отмене создания файла, возникает ошибка »

Скрытый текст
Код:

Option Explicit

Dim strSourceFile


With WScript.CreateObject("Scripting.FileSystemObject")
        strSourceFile = Trim(InputBox("Enter file name:", "Enter file name", .GetAbsolutePathName(GetLocalDate() & ".txt")))
       
        If Len(strSourceFile) > 0 Then
                If Not .FileExists(strSourceFile) Then
                        .CreateTextFile(strSourceFile).Close
                        WScript.CreateObject("Shell.Application").NameSpace(.GetParentFolderName(strSourceFile)).ParseName(.GetFileName(strSourceFile)).InvokeVerb "open"
                End If
        End If
End With

WScript.Quit 0

Function GetLocalDate()
        Dim objSWbemObjectEx
       
        For Each objSWbemObjectEx In WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\cimv2").ExecQuery("SELECT LocalDateTime FROM Win32_OperatingSystem WHERE Primary = 'True'")
                GetLocalDate = Left(objSWbemObjectEx.LocalDateTime, 8)
               
                Exit For
        Next
End Function



Цитата:

Цитата balzaman
а можно такой же скрипт для создания каталога (папки) »

Скрытый текст
Код:

Option Explicit

Dim strSourceFolder


With WScript.CreateObject("Scripting.FileSystemObject")
        strSourceFolder = Trim(InputBox("Enter folder name:", "Enter folder name", .GetAbsolutePathName(GetLocalDate())))
       
        If Len(strSourceFolder) > 0 Then
                If Not .FolderExists(strSourceFolder) Then
                        .CreateFolder strSourceFolder
                        WScript.CreateObject("Shell.Application").Open strSourceFolder
                End If
        End If
End With

WScript.Quit 0

Function GetLocalDate()
        Dim objSWbemObjectEx
       
        For Each objSWbemObjectEx In WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\cimv2").ExecQuery("SELECT LocalDateTime FROM Win32_OperatingSystem WHERE Primary = 'True'")
                GetLocalDate = Left(objSWbemObjectEx.LocalDateTime, 8)
               
                Exit For
        Next
End Function


balzaman 02-10-2019 01:20 2890419

всё работает
премного благодарен Вам за помощь!

balzaman 02-10-2019 03:14 2890426

qttabbar (проверено только на windows xp sp3) - кому интересно расширение
обновил архив новыми скриптами (благодарность Iska)
qttabbar_1.3.0.1_japanese_version_source_new_20191002.exe
https://drive.google.com/open?id=1kZ...7u0JViZVA9zAW_
---
QTTabBar - это удобное расширение Проводника Windows, значительно упрощающее работу, т.к. дает возможность открывать вкладки внутри одного диалогового окна Проводника.
Это приложение действительно полезно, работа в Проводнике становится подобна работе в браузере, когда новая страница открывается во вкладке, а не отдельном окне. Кроме того, утилита позволяет запоминать открытые вкладки, имеет свой фильтр и горячие клавиши, поддерживает различные плагины, а также дает возможность предпросмотра содержимого текстовых и графических файлов.


Время: 02:13.

Время: 02:13.
© OSzone.net 2001-