[решено] Несколько txt в Excel

[bazik83]

Добрый день.
Подскажите как реализовать на vbs скрипт копирующий из txt файлов с разделителем ";" в файл excel на разные листы (название листа соответствует верхней строке файла ). Файлов около 90.
текстовый файл вида:
Computer1
Thu Apr 11 16:05:10 MSK 2013;Last shutdown is OK
Wed Jul 10 13:55:13 MSK 2013;Last shutdown is OK
Wed Jul 10 13:57:37 MSK 2013;Last shutdown is OK
Wed Jul 10 14:02:36 MSK 2013;Last shutdown is OK
Wed Jul 10 14:07:02 MSK 2013;Last shutdown is OK
Wed Jul 10 14:47:17 MSK 2013;Last shutdown is OK
10.07.2013 15:08:20;Last shutdown is OK in -> 10.07.2013 15:07:37
10.07.2013 17:18:16;INCORRECT SHUTDOWN !!!
10.07.2013 17:38:40;Last shutdown is OK in -> 10.07.2013 17:37:56
11.07.2013 08:20:47;INCORRECT SHUTDOWN !!!
12.07.2013 08:41:16;INCORRECT SHUTDOWN !!!
13.07.2013 08:48:59;INCORRECT SHUTDOWN !!!
14.07.2013 08:53:38;Last shutdown is OK in -> 13.07.2013 22:01:15
15.07.2013 08:43:48;Last shutdown is OK in -> 14.07.2013 22:17:39
16.07.2013 08:33:36;Last shutdown is OK in -> 15.07.2013 22:13:40
17.07.2013 08:50:44;Last shutdown is OK in -> 16.07.2013 21:54:25
18.07.2013 08:40:36;Last shutdown is OK in -> 17.07.2013 21:58:18
19.07.2013 09:09:04;Last shutdown is OK in -> 18.07.2013 21:55:55
20.07.2013 08:56:03;Last shutdown is OK in -> 19.07.2013 22:09:23
Есть код для excel, но он импортирует в разные файлы..
Sub ImportTextFiles()
Dim fsSearch As FileSearch
Dim strFileName As String
Dim strPath As String
Dim i As Integer
' Задание пути и возможного имени файла
strFileName = ThisWorkbook.path & "\"
strPath = "*.txt"
' Создание объекта FileSearch
Set fsSearch = Application.FileSearch
' Настройка объекта для поиска
With fsSearch
' Маска для поиска
.LookIn = strFileName
' Путь для поиска
.FileName = strPath
' Поиск всех файлов, удовлетворяющих маске
.Execute
' Выход, если файлы не существуют
If .FoundFiles.Count = 0 Then
MsgBox "Файлы не обнаружены"
Exit Sub
End If
End With
' Обработка найденных файлов
For i = 1 To fsSearch.FoundFiles.Count
Call ImportTextFile(fsSearch.FoundFiles(i))
Next i
End Sub

Sub ImportTextFile(FileName As String)
' Импорт файла
Workbooks.OpenText FileName:=FileName, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Semicolon:=True)
End Sub

[Iska]

Option Explicit

Const xlDelimited = 1

Dim objFSO
Dim strFile
Dim objTS


If WScript.Arguments.Count > 0 Then
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

With WScript.CreateObject("Excel.Application")
With .Workbooks.Add
For Each strFile In WScript.Arguments
If objFSO.FileExists(strFile) Then
Set objTS = objFSO.OpenTextFile(strFile)

With .Worksheets.Add()
.Name = Trim(objTS.ReadLine())
.Cells(1, 1).Value = Trim(objTS.ReadLine())

Do Until objTS.AtEndOfStream
.Cells(.UsedRange.Rows.Count + 1, 1).Value = Trim(objTS.ReadLine())
Loop

objTS.Close

With .UsedRange
.TextToColumns , xlDelimited, , , , True
.EntireColumn.AutoFit
End With
End With

Set objTS = Nothing
Else
WScript.Echo "Can't find source file [" & strFile & "]."
End If
Next
End With

.Visible = True
End With

Set objFSO = Nothing
Else
WScript.Echo "Usage: cscript.exe //nologo " & WScript.ScriptName & " <Source file1> <Source file2> ... <Source fileN>"
End If

WScript.Quit 0

Просто перетащите на скрипт все потребные файлы. Если не хватит длины командной строки — например, длинные пути — будем получать перечень исходных файлов иначе.

[bazik83]

Iska,
Спасибо, а можно ли добавить условие, чтобы добавлялись только файлы содержащие INCORRECT SHUTDOWN !!!

[Iska]

bazik83, файлы или строки?

[bazik83]

Iska, Файлы

[Iska]

При условии, что файлы не гигабайтного размера:
Option Explicit

Const xlDelimited = 1

Dim objFSO
Dim strFile
Dim objTS
Dim strLine
Dim strContent
Dim arrContent
Dim i


If WScript.Arguments.Count > 0 Then
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

With WScript.CreateObject("Excel.Application")
With .Workbooks.Add
For Each strFile In WScript.Arguments
If objFSO.FileExists(strFile) Then
With objFSO.OpenTextFile(strFile)
strLine = Trim(.ReadLine())
strContent = .ReadAll()
.Close
End With

If InStr(1, strContent, "INCORRECT SHUTDOWN !!!", vbTextCompare) > 0 Then
arrContent = Split(strContent, vbCrLf)

With .Worksheets.Add()
.Name = strLine

For i = LBound(arrContent) To UBound(arrContent)
.Cells(i + 1, 1).Value = Trim(arrContent(i))
Next

With .UsedRange
.TextToColumns , xlDelimited, , , , True
.EntireColumn.AutoFit
End With
End With
End If
Else
WScript.Echo "Can't find source file [" & strFile & "]."
End If
Next
End With

.Visible = True
End With

Set objFSO = Nothing
Else
WScript.Echo "Usage: cscript.exe //nologo " & WScript.ScriptName & " <Source file1> <Source file2> ... <Source fileN>"
End If

WScript.Quit 0