Импорт данные из текстового файла (*.txt) в таблицу Excel

[Serg2010]

Доброго времени суток!

Господа, помогите, пожалуйста, написать код выполняющий извлечение нужной информации из текстовый файлов в файл Excel.
Ставлю задачу: в текстовые файлы я сохранил данные сертификатов проверки ключей. Их много, в каждом меня интересует, например СНИЛС:, Фамилия:, Должность:, Подразделение:, Организация: и т.д. Т.е. слева название с двоеточием, справа значение. Потом конец строки. Каждое значение с новой строки.
Один такой обработанный файл равен одной строчки в Excel, столбцы соответствуют искомым значениям.
Далее я просто возьму список сотрудников с их должностями и наложу на полученный файл Excel, при разногласии закажу новый сертификат. Типа сверки, глазами это делать рутинно и тяжело.

Спасибо. Думаю идея понятна.

[Iska]

Serg2010, замечательно. Нам осталось только увидеть образцы этих текстовых файлов и потребной Вам результирующей Рабочей книги Microsoft Excel, упакованных в архив.

[megaloman]

Далее я просто возьму список сотрудников с их должностями и наложу на полученный файл Excel, список в бумажном виде ? :biggrin: Наверное, это тоже таблица и, наверное, в Еxcel. Имхо, логично делать эту операцию (импорт файла и сравнение со списком) макросом в таблице Excel со списком сотрудников. Нужны образцы файлов: список сотрудников, данные сертификатов, в каком виде хотите видеть результат.

[v79italya]

Serg2010, это можно сделать в Power Query. будут файлы - можно сказать конкретнее

[Serg2010]

Спасибо за отклик, выкладываю образцы

[Serg2010]

Образцы

[Iska]

Serg2010, попробуйте так (на WSH):
Option Explicit

Const xlContinuous = 1
Const xlThin = 2
Const xlAutomatic = &HFFFFEFF7


Dim strSourceFolder

Dim objFSO
Dim objFile

Dim strContent

Dim objRegExp

Dim objExcel
Dim objWorkBook
Dim objRange


If WScript.Arguments.Count = 1 Then
strSourceFolder = WScript.Arguments.Item(0)

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(strSourceFolder) Then
Set objRegExp = WScript.CreateObject("VBScript.RegExp")

With objRegExp
.IgnoreCase = True
.MultiLine = True

.Pattern = _
"Серийный номер\r\n" & _
"-{64}\r\n" & _
"((?:[\da-f]{2} ){15}[\da-f]{2})\r\n" & _
"[\s\S]*" & _
"Субъект\r\n" & _
"-{64}\r\n" & _
"СНИЛС: (\d{11})\r\n" & _
"ОГРН: (\d{13})\r\n" & _
"ИНН: (\d{12})\r\n" & _
"Адрес, улица: (.*?)\r\n" & _
"Отчество: .*?\r\n" & _
"Фамилия: .*?\r\n" & _
"Электронная почта: (.*?)\r\n" & _
"Город: (.*?)\r\n" & _
"Область: .*?\r\n" & _
"Страна: .*?\r\n" & _
"Должность: (.*?)\r\n" & _
"Подразделение: (.*?)\r\n" & _
"Организация: (.*?)\r\n" & _
"Имя: (.*?)\r\n"
End With

Set objExcel = WScript.CreateObject("Excel.Application")
Set objWorkBook = objExcel.Workbooks.Add()
Set objRange = objWorkBook.Worksheets.Item(1).Range("A1").Resize(1, 11)

With objRange
.NumberFormat = "@"
.Value = Array( _
"Серийный номер-19", _
"СНИЛС-48", _
"ОГРН-49", _
"ИНН-50", _
"Адрес, улица-51", _
"Электронная почта-54", _
"Город-55", _
"Должность-58", _
"Подразделение-59", _
"Организация-60", _
"Имя-61" _
)
End With

For Each objFile In objFSO.GetFolder(strSourceFolder).Files
If StrComp(objFSO.GetExtensionName(objFile.Name), "txt", 0) = 0 Then
With objFSO.OpenTextFile(objFile.Path)
strContent = .ReadAll()
.Close
End With

Set objRange = objRange.Offset(1, 0)

If objRegExp.Test(strContent) Then
With objRange
.NumberFormat = "@"
.Value = Collection2Array(objRegExp.Execute(strContent).Item(0).Submatches)
End With
Else
WScript.Echo "Can't determine pattern in file [" & objFile.Name & "] correctly."

With objRange
.NumberFormat = "@"
.Value = "Error while parsing file [" & objFile.Name & "]"
End With
End If
Else
' Nothing to do
End If
Next

With objRange.Parent.UsedRange
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

.Columns.AutoFit
End With

objExcel.Visible = True

Set objRange = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
Set objRegExp = Nothing
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
WScript.Quit 2
End If

Set objFSO = Nothing
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source folder>"
WScript.Quit 1
End If

WScript.Quit 0
'-----------------------------------------------------------------------------

'-----------------------------------------------------------------------------
Function Collection2Array(objCollection)
ReDim arrArray(objCollection.Count - 1)
Dim i

For i = LBound(arrArray) To UBound(arrArray)
arrArray(i) = objCollection(i)
Next

Collection2Array = arrArray
End Function
'-----------------------------------------------------------------------------

Путь к целевому каталогу задаётся аргументом скрипта (также можно просто перетянуть папку на скрипт в Проводнике). Если указанный каталог существует, в нём перебираются все текстовые файлы, внутри каждого из которых делается попытка выделения искомых значений по заданному шаблону. При удачном соответствии строка в новосозданной Рабочей книге Microsoft Excel заполняется найденными соответствиями. Поскольку предназначено для ручной работы — сохранение Рабочей книги оставил Вам на откуп.


P.S. См. также Разбираем квалифицированные сертификаты X.509 в поисках ИНН, СНИЛС и ОГРН / Хабр (https://habr.com/ru/post/325998/).

[DJ Mogarych]

$src = gc "C:\temp\Пример обработки сертификата\Петров Иван Иванович.txt"
[array]$data = (($src |select -Skip 16 -First 3) -replace '-{2,}',': ') -join ''
$data += $src |select -Skip 47 -First 15

Получается такой формат:

Серийный номер: 01 D1 1D 91 2F 01 1D 10 00 00 A5 35 21 B1 01 46
СНИЛС: 33333333333
ОГРН: 4444444444444
ИНН: 555555555555
Адрес, улица: пр. Ленина, 1
Отчество: Иван Иванович
Фамилия: Петров
Электронная почта: abc@xyz.ru
Город: Мирный
Область: 11 Прекрасная область
Страна: RU
Должность: начальник отдела
Подразделение: финансовый отдел
Организация: ООО "Цветочки"
Имя: Петров Иван Иванович


Но хоть убей не понимаю, как из этого сделать табличку csv, что-то затупил. Как из первого слова сделать свойство?

[v79italya]

Serg2010, попробуйте вариант в Power Query. Для обновления данных нажмите Ctrl+Alt+F5

[greg zakharov]

Но хоть убей не понимаю, как из этого сделать табличку csv, что-то затупил.
Например: ,[String]((($$=gc file.txt)|select -f 16 -s 3) -replace '-{2,}',':') + ($$|select -s 47 -f 15) | ConvertFrom-Csv -h Data,Value -del ':' | ConvertTo-Csv -no

[YuS_2]

если говорить о powershell, то не проще ли напрямую из сертификатов формировать хэштаблицы и оперировать уже этими данными? Хоть в Excel, хоть сразу сравнивать списки...
Тут постановку задачи лучше скорректировать, чем решать её окольными путями...

[greg zakharov]

YuS_2, скажу больше: достаточно отображения в памяти. Хотя для изобретения велосипеда можно конвертировать и в хэш, однако эффективнее оперировать адресами в памяти, особенно если список сотрудников овердофига. Можно вообще скорее всего задачу решить по типу SQL запросов. Как бы там ни было, Serg2010 усиленно зарабатывает себе статью, пытаясь перекладывать свои проблемы госслужащего на плечи форумных айтишников, сливая интересную информацию (пусть и шаблонного вида).

[YuS_2]

однако эффективнее оперировать адресами в памяти »
Ну, не каждому по силам писать "скрипты" на ассемблере... :)
Тут, что-нибудь попроще бы...
сливая интересную информацию »
Да какая там интересная информация... сертификатов в сети можно найти множество, да и нет там ничего секретного, кроме, собственно, личных данных...

[greg zakharov]

YuS_2, работая в одном из госучреждений, пришлось столкнуться с очень неприятной вещью: подделанные сертификаты. Расследование инцидента вывело на сотрудника, публиковавшего шаблоны данных на форумах с просьбой аналогичной заявленной автором темы. Казалось бы, ничего интересного в примерах нет, но люди сведущие и из этого могут вынести для себя много пользы. И если быть предельно объективным, окажись страна в состоянии кибервойны с какой-либо из развитых технологически стран, последняя одержит вверх, так как более 50% полезной информации лежит в открытом доступе в сети. БД налогоплптельщиков - пожалуйста, данные паспортных столов - нате, данные по медсистеме БАРС - не вопрос. ГосУслуги и вовсе радуют, но там и инфраструктура гнилая начиная с самих сотрудников. А вы говорите ничего интересного... Да, пожалуй, стоит признать свою неправоту перед компетентностью не работавших в госсекторе. В общем, вы правы, дерзайте.

[megaloman]

InName = "Z:\Soft_Arc\Пример обработки сертификата" ' Путь обрабатываемой папки, если он не передаётся в аргументе
'InName = "Z:\Soft_Arc\Пример обработки сертификата\Петров Иван Иванович.txt" ' Путь обрабатываемого файла, если он не передаётся в аргументе

With WScript.Arguments
If .Count <> 0 Then
InName = .Item(0)
End If
End With

Set FSO = CreateObject("Scripting.FileSystemObject")

Look = 0
If (FSO.FolderExists(InName)) Then Look = 1
If (FSO.FileExists(InName)) Then Look = 2

If Look = 0 Then
MsgBox "Not found:" + vbCrLf + vbCrLf + InName, 16, "Error"
WScript.Quit 1
End If

Ext = "txt" ' Расширение файлов при обработке папки
R1 = "B3" ' Начало заголовка генерируемой таблицы
' Перечисление параметров в заголовке
Param = Array("Имя файла", _
"Серийный номер", _
"СНИЛС", _
"ОГРН", _
"ИНН", _
"Адрес, улица", _
"Электронная почта", _
"Город", _
"Должность", _
"Подразделение", _
"Организация", _
"Имя")
N0 = LBound(Param)
NN = UBound(Param)

Set XL = CreateObject("Excel.Application")
XL.Visible = True
XL.Workbooks.Add

Call HeadLine(XL, R1, Param, N0, NN)

ii = 0
If Look = 2 Then
Call InTable(XL, R1, Param, N0, NN, FSO, InName, ii)
Else
On Error Resume Next
LErr = 0
With FSO.GetFolder(InName)
LErr = Not Err.Number <> 0
If Not LErr Then
MsgBox "Error open folder " + vbCrLf + vbCrLf + InName + vbCrLf + vbCrLf + "Err.Number " + CStr(Err.Number) + vbCrLf + Err.Description, 16, "Error"
WScript.Quit 1
Else
For Each InFile In .Files
If LCase(Ext) = LCase(FSO.GetExtensionName(InFile)) Then Call InTable(XL, R1, Param, N0, NN, FSO, InFile, ii)
Next
End If
End With
On Error GoTo 0
End If

XL.Columns(Replace(XL.Range(R1).Address, "$" + CStr(XL.Range(R1).Row), ":") + Replace(XL.Range(R1).Offset(0, NN - N0).Address, "$" + CStr(XL.Range(R1).Row), "")).EntireColumn.AutoFit

Sub HeadLine(XL, R1, Param, N0, NN) ' ---- Формируем заголовок таблицы
For i = N0 To NN
With XL.Range(R1).Offset(0, i - N0)
.Formula = Param(i)
.HorizontalAlignment = -4108
.VerticalAlignment = -4108
.Font.FontStyle = "полужирный"
.Borders(7).Weight = -4138
.Borders(8).Weight = -4138
.Borders(9).Weight = -4138
.Borders(10).Weight = -4138
End With
Next
End Sub

Sub InTable(XL, R1, Param, N0, NN, FSO, InName, ii) ' ---- Содержимое файла помещаем в строку таблицы
On Error Resume Next
LErr = 0
With FSO.OpenTextFile(InName, 1)
LErr = Not Err.Number <> 0
If Not LErr Then
MsgBox "Error open file " + vbCrLf + vbCrLf + InName + vbCrLf + vbCrLf + "Err.Number " + CStr(Err.Number) + vbCrLf + Err.Description
Exit Sub
Else
InTxt = .ReadAll
LErr = Not Err.Number <> 0
If Not LErr Then
MsgBox "Error read file " + vbCrLf + vbCrLf + InName + vbCrLf + vbCrLf + "Err.Number " + CStr(Err.Number) + vbCrLf + Err.Description
Exit Sub
End If
End If
.Close
End With
On Error GoTo 0
j1 = InStr(1, InTxt, vbCrLf + Param(N0 + 1))

If j1 > 0 Then
j1 = InStr(j1 + 1, InTxt, vbCrLf)
j1 = InStr(j1 + 1, InTxt, vbCrLf) + 2
j2 = InStr(j1, InTxt, vbCrLf)

jj1 = InStr(j2, InTxt, vbCrLf + "Субъект")
jj1 = InStr(jj1 + 1, InTxt, vbCrLf)
jj1 = InStr(jj1 + 1, InTxt, vbCrLf) + 2
jj2 = InStr(jj1, InTxt, vbCrLf + "-------")

ii = ii + 1
With XL.Range(R1)
.Offset(ii, 0) = FSO.GetFileName(InName)
.Offset(ii, 1) = Trim(Mid(InTxt, j1, j2 - j1 + 1))
InTxt = Mid(InTxt, jj1, jj2 - jj1 + 1)
For i = N0 + 2 To NN
j1 = InStr(1, InTxt, Param(i) + ":")
If j1 <> 0 Then
j1 = InStr(j1, InTxt, ":")
j2 = InStr(j1, InTxt, vbCrLf)
.Offset(ii, i - N0) = Mid(InTxt, j1 + 1, j2 - j1)
End If
Next
End With
End If
End Sub
Путь к каталогу или файлу задаётся аргументом скрипта (также можно просто перетянуть папку или файл на скрипт в Проводнике), либо, при отсутствии аргумента, явно в скрипте. Поскольку предназначено для ручной работы — сохранение Рабочей книги оставил Вам на откуп.
Я счёл необходимым добавить в Excel-таблицу поле с именем файла.

[DJ Mogarych]

greg zakharov, вы не дочитали до конца.
Как из первого слова сделать свойство? »

[greg zakharov]

DJ Mogarych, что вы разумеете под свойством? Что вы желаете получить?

[DJ Mogarych]

Чтобы первое слово (до двоеточия) было названием столбца, а второе - значением.

[Busla]

DJ Mogarych, примерно так:

$data = @'
Серийный номер: 01 D1 1D 91 2F 01 1D 10 00 00 A5 35 21 B1 01 46
СНИЛС: 33333333333
ОГРН: 4444444444444
ИНН: 555555555555
Адрес, улица: пр. Ленина, 1
Отчество: Иван Иванович
Фамилия: Петров
Электронная почта: abc@xyz.ru
Город: Мирный
Область: 11 Прекрасная область
Страна: RU
Должность: начальник отдела
Подразделение: финансовый отдел
Организация: ООО "Цветочки"
Имя: Петров Иван Иванович
'@

$data -split "`n" | .{
begin { $resultHashTable = @{} }
process { $_ -match '(?<name>[^:]*):(?<value>.*)' | Out-Null ; $resultHashTable[$Matches['name']] = $Matches['value'] }
end { [PSCustomObject]$resultHashTable }
}

можно вместо регулярки просто split использовать

но лучше бы топикстартер и не пытался делать этот шаг: в текстовые файлы я сохранил данные сертификатов проверки ключей

[DJ Mogarych]

Busla, какой ужас. :)