Переименование папок в директории

Sub RenameFoldersInFolders()
    Dim parentFolderPath As String
    Dim fso As Object
    Dim parentFolder As Object
    Dim subFolder As Object
    Dim newFolderName As String
    Dim counter As Integer
    
    ' Укажите путь к родительской папке, в которой находятся подпапки
    parentFolderPath = "R:\ххххх\_Новая\ПАПКА" ' Измените на путь к вашей родительской папке
    
    ' Создаем объект FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Проверяем, существует ли родительская папка
    If Not fso.FolderExists(parentFolderPath) Then
        MsgBox "Родительская папка не найдена!"
        Exit Sub
    End If
    
    ' Открываем родительскую папку
    Set parentFolder = fso.GetFolder(parentFolderPath)
    
    ' Счетчик для создания уникальных имен
    counter = 1
    
    ' Перебираем все подпапки в родительской папке
    For Each subFolder In parentFolder.Subfolders
        ' Пример нового имени папки: "Folder_1", "Folder_2" и так далее
'        newFolderName = "Folder_" & counter
        
        CurentName = subFolder.Name
        newName = Replace(CurentName, "++", "")
         If subFolder.Name <> newName Then subFolder.Name = newName
        
        ' Переименовываем папку
'        Name parentFolderPath & CurentName as & "\" & newFolderName
'        subFolder = parentFolderPath & "\" & newFolderName
        
        ' Увеличиваем счетчик
        counter = counter + 1
    Next subFolder

    MsgBox "Переименование папок завершено!"
End Sub

Sub ДвоичныйПоиск()

Sub ДвоичныйПоиск()
    
    txtFind = "01.02.2023"
    
    first = 1
    last = 51
    Length = 50
    half0 = 26
    i = 1
    Length = first + last
    Do While last >= first
        half = Round((first + last) / 2)
        
       If Range("B" & half) = CDate(txtFind) Then
          For Row = half To 50
            If Range("B" & Row) <> CDate(txtFind) Then
                xx = Row
                Exit For
            End If
          Next Row
        Debug.Print "Кол-во операций: " & i & " последний элемент " & xx - 1
        Exit Sub
       End If
        
        If Range("B" & half).Value > CDate(txtFind) Then    'Range("B" & half) > txtFind   'DateDiff("d", txtFind, Range("B" & half)) > 0
            last = half - 1
        Else
            first = half + 1
        End If
    i = i + 1
    Loop
    
    
    
    Debug.Print "Значение не найдено. Кол-во операций " & i
End Sub

Переименовать элемент справочника

Процедура ПереименоватьНажатие(Элемент)
	// Вставить содержимое обработчика.
	
	Если Гараж  = Справочники.спГараж.ПустаяСсылка() тогда
		 возврат;
	КонецЕсли;
	 
	ОбъектГараж = Гараж.ПолучитьОбъект();
	ОбъектГараж.Наименование = НовоеИменование;
	ОбъектГараж.Записать();
	
	Гараж = ОбъектГараж.Ссылка;
	
КонецПроцедуры
Рубрика: 1C

Найти элемент в справочнике

Процедура НайтиГаражНажатие(Элемент)
	// Вставить содержимое обработчика.
	Если ПустаяСтрока(ТекущееНазвание)  тогда
		возврат;
	конецЕсли;
	
	Гараж = Справочники.спГараж.НайтиПоНаименованию(ТекущееНазвание,Истина);
КонецПроцедуры

Удалить элементы справочника по условию


Процедура ДействияФормыУдалить(Кнопка)
	// Вставить содержимое обработчика.
	Выборка = Справочники.спАвтомобили.Выбрать();
	
	Пока Выборка.Следующий() = 1 Цикл
		Если Выборка.Марка.Пустая() тогда
			   Сообщить(Выборка.Марка);
			   Выборка.ПолучитьОбъект().Удалить();
		КонецЕсли
			КонецЦикла;
КонецПроцедуры
Рубрика: 1C

Работа с буфером

‘Public Sub SetTextIntoClipboard(ByVal txt As String) ‘ Dim MyDataObj As New DataObject ‘ MyDataObj.SetText txt ‘ MyDataObj.PutInClipboard ‘End Sub   Sub SetTextIntoClipboard(ByVal txt$) ‘ Запись в буфер With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .SetText txt$ .PutInClipboard End With End Sub   Sub Extract_Unique() Dim Продолжить чтение Работа с буфером

Открыть диалоговое окно

    Sub ShowGetOpenDialod() Dim avFiles ‘по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb) avFiles = Application.GetOpenFilename _ ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True) If VarType(avFiles) = vbBoolean Then ‘была нажата кнопка отмены — выход из процедуры Exit Sub Продолжить чтение Открыть диалоговое окно

Word надстройки З-н

Sub addTable() Dim wb As Excel.Workbook With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False .Title = «Выбрать файлы отчетов» ‘заголовок окна диалога .Filters.Clear ‘очищаем установленные ранее типы файлов .Filters.Add «Excel files», «*.xls*;*.xla*», 1 ‘устанавливаем возможность выбора только файлов Excel .FilterIndex = 2 ‘устанавливаем Продолжить чтение Word надстройки З-н