CMD/BAT - [решено] Составить список файлов из папки в заданном виде

[burolf]

Цитата burolf:



Я хочу потом данный текст скопировать в Макрос excel и создать файл с гиперссылками на файлы в папке, в которой этот батник будет запущен.

CMD/BAT - [решено] Составить список файлов из папки в заданном виде

Это особо циничное извращение , но вот решение, как Вы этого хотели:

Код:

Код: Выделить всё

@Echo Off
cls
>nul Chcp 1251
	Set "BoxIn=Z:\Box_In\У попа была собака"
	Set "Mask=*.*"
	Set "FileOut=Z:\Бред сивой кобылы.txt"
	Set /A N=0
	>"%FileOut%" (FOR /F "usebackq delims=" %%f IN (`2^>nul Dir /B /A:-D "%BoxIn%\%Mask%"`) DO (
		Call Set /A N+=1
		Call Echo ActiveSheet.Hyperlinks.Add Anchor:=Range^("A%%N%%"^), Address:="%BoxIn%\%%f", TextToDisplay:="%BoxIn%\%%f"
	))
pause
Exit /B

Батник сохранить в 1251 кодировке


Вот макрос Excel для создания в ячейках гиперссылок на файлы в указанной папке безо всяких txt

[spoiler]Код:

[/spoiler]

Код: Выделить всё

Sub DirGiper()
MyDir = "Z:\Box_In\У попа была собака"
MyMask = "^.*\..*$"
Set Reg = CreateObject("VBScript.RegExp")
Reg.IgnoreCase = True
Reg.Pattern = MyMask
With CreateObject("Scripting.FileSystemObject")
    Set Files = .GetFolder(MyDir).Files
    N = 0
    For Each File In Files
        Filename = File.Path
        If Reg.Test(Filename) Then
            N = N + 1
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" + CStr(N)), Address:=Filename, TextToDisplay:=Filename
        End If
    Next
End With
MsgBox "Done"
End Sub

Вот VBS-скрипт (создать файл с расширением .vbs в 1251 кодировке и выполнить его), и никакого левого txt-файла и ручной работы не потребуется

[spoiler]Код:

[/spoiler]

Код: Выделить всё

MyDir = "Z:\Box_In\У попа была собака"
MyMask = "^.*\..*$"
Set Reg = CreateObject("VBScript.RegExp")
Reg.IgnoreCase = True
Reg.Pattern = MyMask
Set Files = CreateObject("Scripting.FileSystemObject").GetFolder(MyDir).Files
With CreateObject("Excel.Application")
	.Visible = True
	.Workbooks.Add
    	N = 0
	For Each File In Files
		Filename = File.Path
		If Reg.Test(Filename) Then
			N = N + 1
			Call .ActiveSheet.Hyperlinks.Add(.Range("A" + CStr(N)), Filename)
		End If
	Next
End With

Естественно, в любом решении надо прописать свои пути.

[burolf]

Друзья! Спасибо огромное за помощь! Первый предложенный вариант действительно работает, просто надо было обновиться. Но хотелось бы выделить пользователя megaloman он предложил самый точный вариант соответствующий ТЗ и кроме того добавил самый адекватный и логически правильный вариант решения данной проблемы! Его макрос работает. Всем рекомендую! Спасибо ресурсу за возможность решения моей проблемы так быстро!

[burolf]

[post]Вот макрос Excel для создания в ячейках гиперссылок на файлы в указанной папке безо всяких txt[post]



А как бы сделать чтобы после запуска данного макроса в результате в ячейке отображался не путь к папке, а что-то вроде кнопки или слово "ССЫЛКА" и ячейка подсвечивалась каким-либо цветом, к примеру нежно зеленым.

[megaloman]

после запуска данного макроса в результате в ячейке отображался не путь к папке, а что-то вроде кнопки или слово "ССЫЛКА" и ячейка подсвечивалась каким-либо цветом, к примеру нежно зеленым

[spoiler]Код:

[/spoiler]

Код: Выделить всё

Sub DirGiper0()
MyDir = "Z:\Box_In\У попа была собака"
MyMask = "^.*\..*$"
Set Reg = CreateObject("VBScript.RegExp")
Reg.IgnoreCase = True
Reg.Pattern = MyMask
With CreateObject("Scripting.FileSystemObject")
    Set Files = .GetFolder(MyDir).Files
    N = 0
    For Each File In Files
        Filename = File.Path
        If Reg.Test(Filename) Then
            N = N + 1
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" + CStr(N)), Address:=Filename, TextToDisplay:="Ссылка"
            With Range("A" + CStr(N))
                With .Font
                    .FontStyle = "полужирный курсив"
                End With
                With .Interior
                    .Pattern = xlSolid
                    .Color = 12314553
                End With
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
            End With
        End If
    Next
End With
MsgBox "Done"
End Sub