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

[burolf]

Дорого времени суток, великие и могучие!
Помогите пожалуйста. Как сделать батник, который из папки с файлами смог бы сформировать файл txt по следующему принципу:

В папке есть n количество файлов (оно всегда растет)

Необходимо в txt файле создать текст следующего формата:

Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="P:\files\название файла с расширением" _
, TextToDisplay:="P:\files\название файла с расширением"
Range("A2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="P:\files\название второго файла с расширением" _
, TextToDisplay:="P:\files\название второго файла с расширением"
.......................
Range("An").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="P:\files\название n-ого файла с расширением" _
, TextToDisplay:="P:\files\название n-ого файла с расширением"

В этом случае "P:\files\" константа, которую можно задавать в зависимости от расположения файла перед запуском батника

ЛИБО

Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="название файла с расширением и путем к нему" _
, TextToDisplay:="название файла с расширением и путем к нему"
Range("A2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="название второго файла с расширением и путем к нему" _
, TextToDisplay:="название второго файла с расширением и путем к нему"
.............................
Range("An").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="название n-ого файла с расширением и путем к нему" _
, TextToDisplay:="название n-ого файла с расширением и путем к нему"


Кому интересно для чего это мне необходимо. Я хочу потом данный текст скопировать в Макрос excel и создать файл с гиперссылками на файлы в папке, в которой этот батник будет запущен.
Непосредственно в excel не раздуплю как это сделать. Помогите пожалуйста. Или подскажите какой софт есть для автоматизации этого процесса.

[Fors1k]

создать файл с гиперссылками на файлы в папке »
param(
$pathFolder = 'C:\files',
$pathXls = 'C:\docs\links.xlsx'
)cls

$Excel = New-Object -ComObject Excel.Application
$WorkBook = $Excel.Workbooks.Add()
$WorkSheet = $WorkBook.Worksheets.Item(1)
gci $pathFolder -rec -file|%{$i=1}{
[void]$WorkSheet.Cells.Hyperlinks.Add(
$workbook.Worksheets.Item(1).Cells.Item($i++,1),$_.FullName
)
}
$Range = $WorkSheet.UsedRange
[void]$Range.EntireColumn.AutoFit()
$workBook.saveAs($pathXls);$excel.Quit()
[Runtime.InteropServices.Marshal]::ReleaseComObject($excel)

[greg zakharov]

Fors1k, а кто экземпляр COM освободит? Хотя по идее это должен делать GC, в действительности этого никогда не произойдёт. Поэтому помимо прочего нужно вызвать ReleaseComObject после Quit ([Runtime.InteropServices.Marshal]::RealeaseComObject($excel)).

[burolf]

Я скопировал этот текст в батник, запустил, но файл не создался. Что я делаю не так? (

[Elven]

Наверное, потому, что это не батник. Сохраните текст в файле с расширением ps1 и запускайте через powershell.

[burolf]

Запустил код :

param(
$pathFolder = 'p:\file',
$pathXls = 'p:\links.xlsx'
)cls

$Excel = New-Object -ComObject Excel.Application
$WorkBook = $Excel.Workbooks.Add()
$WorkSheet = $WorkBook.Worksheets.Item(1)
gci $pathFolder -rec -file|%{$i=1}{
[void]$WorkSheet.Cells.Hyperlinks.Add(
$workbook.Worksheets.Item(1).Cells.Item($i++,1),$_.FullName
)
}
$Range = $WorkSheet.UsedRange
[void]$Range.EntireColumn.AutoFit()
$workBook.saveAs($pathXls);$excel.Quit()
[Runtime.InteropServices.Marshal]::ReleaseComObject($excel)

через powershell. Файл xlsx создался, УРА! но он пустой, там нет никаких ссылок. (

Выдает еще ошибку :

Get-ChildItem : Не удается найти параметр, соответствующий имени параметра "file".
строка:1 знак:27
+ gci $pathFolder -rec -file <<<< |%{$i=1}{
+ CategoryInfo : InvalidArgument: (:) [Get-ChildItem], ParameterBindingException
+ FullyQualifiedErrorId : NamedParameterNotFound,Microsoft.PowerShell.Commands.GetChildItemCommand

[alpap]

текст скопировать в Макрос excel и создать файл с гиперссылками на файлы в папке »
чего не сразу из txt файла

@echo off
set "spath=C:\Papka"

>file.txt (for /f "delims=" %%a in ('dir /a-d/b/s "%spath%\*.*"') do @set "f=%%a"& call echo file:///%%f:\=/%%)
pause

Забыл указать, текстовый редактор должен быть не штатный виндовый блокнот, а что-то посолиднее, иначе наверное не получится.

[burolf]

спасибо за участие, но при таком варианте просто создается txt файл с адресами на файлы и все. Как сделать именно гиперссылки внутри excel?

[burolf]

спасибо за участие, но при таком варианте просто создается txt файл с адресами на файлы и все. Как сделать именно гиперссылки внутри excel?

[Fors1k]

Выдает еще ошибку »
$host.Version.Major
Если покажет меньше пяти, то установите обновление:
https://www.microsoft.com/en-us/download/details.aspx?id=54616

[megaloman]

Я хочу потом данный текст скопировать в Макрос excel и создать файл с гиперссылками на файлы в папке, в которой этот батник будет запущен. » Это особо циничное извращение :), но вот решение, как Вы этого хотели:@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 кодировке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
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]

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

[megaloman]

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