zepete: (Default)
[personal profile] zepete
Осциллографы tektronix могут сохранять временные диаграммы в формате csv. Эти файлы рускоязычный excel непонимает, так как там вместо запятых точки, а вместо табов запятые. Поэтому для преобразования его файлов в формат понятный excel создал такой скрипт.

'***************************************************************************************
'* программа преобразования файлов осциллографа tektronix для excel                    *
'* Автор zepete.livejournal.com                                                        *
'***************************************************************************************
Option Explicit
const PointChar=44	' на какой символ менять десятичную точку
const DelimiterChar=9  ' на какой символ менять разделитель полей
dim FSO			:	set FSO=CreateObject("Scripting.FileSystemObject")
dim WshShell		:	set WshShell=CreateObject("WScript.Shell")
dim regexp		:	set regexp=CreateObject("VBScript.RegExp")
dim sFolderName		:	sFolderName=WshShell.CurrentDirectory
dim folder		:	set folder=FSO.GetFolder(sFolderName)
dim iCount		:	iCount=0
dim file
dim str
dim objTekFile()
dim sTextOutFile()
dim obj
dim i
dim ReadFile
dim WriteFile
dim ExcelApp
regexp.IgnoreCase=TRUE
For Each File In Folder.Files
	regexp.Pattern="^TEK\d\d\d\d[.]CSV"
	if regexp.Test(File.Name) then
		regexp.Pattern="[.]CSV$"
		redim preserve objTekFile(iCount)
		redim preserve sTextOutFile(iCount)		
		set objTekFile(Ubound(objTekFile))=File
		sTextOutFile(Ubound(objTekFile))=regexp.replace(File.Name,"_xls.csv")
		iCount=iCount+1
	end if
Next
if iCount=0 then
	WScript.Echo "Current folder do not consist tektronix files"
	WScript.Quit
end if

'преобразование файла в понятный вид
For i=0 to iCount-1
	Set ReadFile=objTekFile(i).OpenAsTextStream(1,0)
	Set WriteFile=folder.CreateTextFile(sTextOutFile(i),False,true)
	While Not ReadFile.AtEndOfStream
		Str = ReadFile.ReadLine()
		Str=Replace(Str,",",chr(DelimiterChar))
		Str=Replace(Str,".",chr(PointChar))
		WriteFile.WriteLine(str)
	Wend
	WriteFile.Close
	ReadFile.Close
Next

'преобразование csv в xls
Set ExcelApp = CreateObject("Excel.Application")
On Error resume next
'ExcelApp.DisplayAlerts = False
For i=0 to iCount-1
	ExcelApp.WorkBooks.OpenText sFolderName+"\"+sTextOutFile(i)
	if Err.Number >0 then
		ExcelApp.Quit
		MsgBox "Error Excel Open file """+sFolderName+"\"+sTextOutFile(i)+""""
		WScript.Quit
	end if
	regexp.Pattern="[.]CSV$"
	str=regexp.replace(sTextOutFile(i),".xls")
	ExcelApp.ActiveWorkbook.SaveAs sFolderName+"\"+str, 18
	if Err.Number >0 then
		ExcelApp.Quit
		MsgBox "Error Excel write file """+sFolderName+"\"+str+""""
		WScript.Quit
	end if
Next
ExcelApp.Quit

Date: 2016-11-30 01:28 pm (UTC)
From: [identity profile] shark-ru.livejournal.com
Любите Help -- источник знаний.
https://msdn.microsoft.com/en-us/library/office/ff837097(v=office.15).aspx

Date: 2018-10-05 09:55 am (UTC)
From: [identity profile] zepete.livejournal.com
Как этот Workbooks.OpenText внедрить в командную строку, что бы по двойному клику на файл csv вызывался?

Profile

zepete: (Default)
zepete

January 2026

S M T W T F S
    1 23
4 56 78910
11121314151617
18192021222324
25262728293031

Style Credit

Expand Cut Tags

No cut tags
Page generated Jan. 14th, 2026 04:57 am
Powered by Dreamwidth Studios