Форум программистов, компьютерный форум, киберфорум
VBScript/JScript/WSH/WMI/HTA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.86/7: Рейтинг темы: голосов - 7, средняя оценка - 4.86
0 / 0 / 0
Регистрация: 01.02.2017
Сообщений: 6
1
VBS

По очереди открывать каждый CSV-файл, запускать макрос и сохранять этот файл в формате XLSX

02.02.2017, 00:06. Просмотров 1412. Ответов 11
Метки нет (Все метки)


Добрый день. Помогите написать скрипт который будет:

У меня есть много файлов в папке С:\1\ имя1.csv имя2.csv .... имя99.csv
Нужно чтобы скрипт открывал файлы по очереди и запускал макрос, после выполнения макроса сохранял файл в С:\2\ как имя1.xlsx имя2.xlsx .... имя99.xlsx


Добавлено через 1 час 25 минут
Нашел на сайте вот этот скрипт:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
strTempPath = "D:\PRIBOR"
Set objFSO=CreateObject("Scripting.FileSystemObject") 
Set objFolder=objFSO.GetFolder(strTempPath) 
 
 
For Each objFile In objFolder.Files 
Ext = Mid(objFile, InstrRev(objFile, ".") + 1)
 
If Ext = "xls" Then 
OutFile = Left(objFile.Path, Len(objFile.Path) - Len(Ext) - 1)
Set XL = CreateObject("Excel.Application")
XL.Visible = False
XL.Workbooks.Open objFile
XL.ActiveWorkbook.SaveAs OutFile & ".csv",6
XL.ActiveWorkbook.Saved = True
XL.ActiveWindow.Close
XL.Quit
End If
Next
Он открывает файл и сохраняет с другим расширением. Помогите дописать его, чтобы перед закрытием он сначала выполнял макрос

Добавлено через 1 час 10 минут
Заметил такую проблему, если запустить первую часть скрипта:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
 strTempPath = "D:\PRIBOR"
Set objFSO=CreateObject("Scripting.FileSystemObject") 
Set objFolder=objFSO.GetFolder(strTempPath) 
 
 
For Each objFile In objFolder.Files 
Ext = Mid(objFile, InstrRev(objFile, ".") + 1)
 
If Ext = "csv" Then 
OutFile = Left(objFile.Path, Len(objFile.Path) - Len(Ext) - 1)
Set XL = CreateObject("Excel.Application")
XL.Visible = True
XL.Workbooks.Open objFile
End
То имя.csv открывается и значения всех ячеек переносятся в столбец А и разделяются между собой знаком ; (2;5;65;56;34;76).
А если открыть файл имя.csv вручную, то все нормально, каждое значение в своей ячейки. Подскажите как открыть скриптом этот долбанный.csv чтобы значения оставались в своих ячейках?
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
02.02.2017, 00:06
Ответы с готовыми решениями:

Как можно открывать и сохранять файл через диалоговые окна?
Есть типизированная файловая переменная, как можно открывать и сохранять файл через диалоговые окна?

Ряд динамически созданных MaskedTextBox сохранять в файл/открывать из файла
Помогите разобраться с SaveFileDialog. Вот наворотил : private void...

Макрос. Файл закрыть и не сохранять
Всем доброго времени суток. собственно, вопрос прописан в теме . этот код ...

Помогите пожалуйста, не могу разобраться как сохранять файл, например в формате bmp?
Помогите пожалуйста, не могу разобраться как сохранять файл, например в формате bmp? uses ...

11
2616 / 546 / 109
Регистрация: 21.03.2012
Сообщений: 1,051
02.02.2017, 10:08 2
Цитата Сообщение от Tromal5 Посмотреть сообщение
... перед закрытием он сначала выполнял макрос...
используйте метод Run объекта Application:
Visual Basic
1
XL.Run "module1.test1"
Здесь test1 - имя запускаемого макроса, module1 - имя модуля, в котором описан макрос.
Цитата Сообщение от Tromal5 Посмотреть сообщение
... как открыть скриптом этот долбанный.csv чтобы значения оставались в своих ячейках?
Попробуйте использовать вместо метода Open объекта Workbooks метод OpenText того же объекта, указав True в качестве значения параметра Local (он последний, 18-й по счёту):
Visual Basic
1
XL.Workbooks.OpenText objFile, , , , , , , , , , , , , , , , , True
0
0 / 0 / 0
Регистрация: 01.02.2017
Сообщений: 6
02.02.2017, 12:21  [ТС] 3
Попробовал запустить на рабочем компе, получается совсем странно:
Исходный csv:
Код
       А      В      С      D
1:  Пусто | 3,15 | 5,67 | 4,85 |
2:  Пусто | 5,66 | 9,99 | 2,25 |
3:  Пусто | 1,45 | 5,08 | 6;53 |
Открывается методом Open:
Код
        А          В      С      D
1:      3;     | 15;5 | 67;4 |  85  |
2:      5;     | 66;9 | 99;2 |  25  |
3:      1;     | 45;5 | 08;6 |  53  |
Открывается методом OpenText:
Код
               А            В       С       D
1:      3;15;5;67;4;85  | Пусто | Пусто | Пусто | 
2:      5;66;9;99;2;25  | Пусто | Пусто | Пусто | 
3:      1;45;5;08;6;53  | Пусто | Пусто | Пусто |
0
2616 / 546 / 109
Регистрация: 21.03.2012
Сообщений: 1,051
02.02.2017, 12:30 4
Tromal5, приложите, пожалуйста, исходный CSV-файл (если не секрет, конечно).
0
0 / 0 / 0
Регистрация: 01.02.2017
Сообщений: 6
02.02.2017, 14:26  [ТС] 5
В архиве исходный csv и конечный результат xlsx
0
Вложения
Тип файла: zip download.zip (591.0 Кб, 4 просмотров)
2616 / 546 / 109
Регистрация: 21.03.2012
Сообщений: 1,051
02.02.2017, 21:24 6
В вашем случае открывать CSV-файл надо так:
Visual Basic
1
XL.Workbooks.OpenText objFile, , , , , , , True
Однако, вероятно, будет проблема с кириллицей, т.к. исходный файл имеет кодировку UTF-8.
В этом случае перевести заголовочную часть на рабочем листе в нормальный вид можно, например, так:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Set objFS = CreateObject("Scripting.FilesystemObject")
arrTemp = Split(objFS.OpenTextFile(objFile, 1).ReadAll, ";")
strTemp = StrConv(arrTemp(1), "utf-8", "windows-1251")
Set XL = CreateObject("Excel.Application")
XL.Visible = True
XL.Workbooks.OpenText objFile, , , , , , , True
XL.ActiveWorkbook.Worksheets(1).Range("a1").Value = StrConv(arrTemp(0), "utf-8", "windows-1251")
XL.ActiveWorkbook.Worksheets(1).Range("b1").Value = Mid(strTemp, 1, InStr(strTemp, vbLf) - 1)
XL.ActiveWorkbook.Worksheets(1).Range("a3").Value = Mid(strTemp, InStrRev(strTemp, vbLf) + 1)
 
'======
 
Function StrConv(strTxt, strSrcCharset, strDstCharset)
Dim objStream
 
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 2
objStream.Mode = 3
objStream.Open
objStream.Charset = strDstCharset
objStream.WriteText strTxt
objStream.Position = 0
objStream.Charset = strSrcCharset
StrConv = objStream.ReadText
End Function
0
0 / 0 / 0
Регистрация: 01.02.2017
Сообщений: 6
23.03.2017, 11:09  [ТС] 7
Спасибо за помощь, сейчас файл открывается и сохраняется как нужно. Но так как этот файл будет использоваться на разных компьютерах, то макрос нужно вписать​ внутри кода.С этим у меня небольшая проблема.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
strTempPath = "C:\Do*cuments and Settings*\757-Shishov\Рабочий стол\груздов"
Set objFSO=CreateObj*ect("Scripting.FileS*ystemObject")
Set objFolder=objFSO*.GetFolder(strTempPa*th)    
For Each objFile In objFolder.Files
Ext = Mid(objFile, InstrRev(objFile, ".") + 1)  
If Ext = "csv" Then OutFile = Left(objFi*le.Path, Len(objFile*.Path) - Len(Ext) - 1)
 
Set XL = CreateObjec*t("Excel.Application*")
XL.Visible = True
'XL.Workbooks.Open objFile,,,,,,,,,,,,,T*rue
 
XL.Workbooks.OpenText objFile, , , , , , , True
 
 
XL.Columns("A:A").Se*lect
    XL.Selection.Del*ete Shift = xlToLeft
    XL.Rows("1:1").S*elect
    XL.Selection.Del*ete Shift = xlUp
    XL.Selection.Del*ete Shift = xlUp
    XL.Cells.Select
    XL.Range("HO208"*).Activate
    XL.Selection.Col*umnWidth = 0.25
    XL.Cells.EntireR*ow.AutoFit               
    XL.Selection.Row*Height = 2.25
    XL.ActiveWindow.*ScrollRow = 1
    XL.ActiveWindow.*ScrollColumn = 1
 
    XL.Selection.For*matConditions.AddCol*orScale ColorScaleTy*pe = 3
XL.Selection.For*matConditions(Select*ion.FormatConditions*.Count).SetFirstPrio*rity
XL.Selection.For*matConditions(1).Col*orScaleCriteria(1).T*ype = _
        xlConditionV*alueLowestValue
    With XL.Selectio*n.FormatConditions(1*).ColorScaleCriteria*(1).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
XL.Selection.For*matConditions(1).Col*orScaleCriteria(2).T*ype = _
        xlConditionV*aluePercentile
XL.Selection.For*matConditions(1).Col*orScaleCriteria(2).V*alue = 50
    With XL.Selectio*n.FormatConditions(1*).ColorScaleCriteria*(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
XL.Selection.For*matConditions(1).Col*orScaleCriteria(3).T*ype = _
        xlConditionV*alueHighestValue
    With XL.Selectio*n.FormatConditions(1*).ColorScaleCriteria*(3).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
 
 
'XL.ActiveWorkbook.S*aveAs OutFile & ".xl*sx" , 51
'XL.ActiveWorkbook.S*aved = True
'XL.ActiveWindow.Clo*se
'XL.Quit
 
Next
Строка: 28
Символ: 5
Ошибка: Индекс выходит за пределы допустимого диапазона.
До этой строки все работает как нужно.

Добавлено через 14 минут
Сори, В коде появились звездочки почему-то, не могу убрать их. Вот еще раз код без звездочек.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
strTempPath = "C:\Documents and Settings\757-Shishov\Рабочий стол\груздов"
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objFolder=objFSO.GetFolder(strTempPath)    
For Each objFile In objFolder.Files
Ext = Mid(objFile, InstrRev(objFile, ".") + 1)  
If Ext = "csv" Then OutFile = Left(objFile.Path, Len(objFile.Path) - Len(Ext) - 1)
 
Set XL = CreateObject("Excel.Application")
XL.Visible = True
'XL.Workbooks.Open objFile,,,,,,,,,,,,,True
 
XL.Workbooks.OpenText objFile, , , , , , , True
 
 
XL.Columns("A:A").Select
    XL.Selection.Delete Shift = xlToLeft
    XL.Rows("1:1").Select
    XL.Selection.Delete Shift = xlUp
    XL.Selection.Delete Shift = xlUp
    XL.Cells.Select
    XL.Range("HO208").Activate
    XL.Selection.ColumnWidth = 0.25
    XL.Cells.EntireRow.AutoFit               
    XL.Selection.RowHeight = 2.25
    XL.ActiveWindow.ScrollRow = 1
    XL.ActiveWindow.ScrollColumn = 1
 
    XL.Selection.FormatConditions.AddColorScale ColorScaleType = 3
XL.Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
XL.Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With XL.Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
XL.Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
XL.Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With XL.Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
XL.Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With XL.Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
 
 
'XL.ActiveWorkbook.SaveAs OutFile & ".xlsx" , 51
'XL.ActiveWorkbook.Saved = True
'XL.ActiveWindow.Close
'XL.Quit
 
Next
0
2616 / 546 / 109
Регистрация: 21.03.2012
Сообщений: 1,051
23.03.2017, 12:05 8
Оператор в строке 28 должен выглядеть так:
Visual Basic
1
XL.Selection.FormatConditions.AddColorScale 3
1
0 / 0 / 0
Регистрация: 01.02.2017
Сообщений: 6
23.03.2017, 13:03  [ТС] 9
Спасибо, помогло. Оставил только эту строчку, остальные убрал, так как они все равно не дают нужный мне результат.
Сейчас код работает, но есть один недостаток.
Когда он раскрашивает ячейки, то он меньшие значения красит в красный, а большие в зеленый. Впринципе можно оставить и так, но так как это тепловизионный снимок, то гарячие места хотелось бы видеть красным, а не зеленым.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
strTempPath = "C:\Documents and Settings\757-Shishov\Рабочий стол\груздов"
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objFolder=objFSO.GetFolder(strTempPath)    
For Each objFile In objFolder.Files
Ext = Mid(objFile, InstrRev(objFile, ".") + 1)  
If Ext = "csv" Then OutFile = Left(objFile.Path, Len(objFile.Path) - Len(Ext) - 1)
 
Set XL = CreateObject("Excel.Application")
XL.Visible = True
'XL.Workbooks.Open objFile,,,,,,,,,,,,,True
 
XL.Workbooks.OpenText objFile, , , , , , , True
 
 
XL.Columns("A:A").Select
    XL.Selection.Delete Shift = xlToLeft
    XL.Rows("1:1").Select
    XL.Selection.Delete Shift = xlUp
    XL.Selection.Delete Shift = xlUp
    XL.Cells.Select
    XL.Range("HO208").Activate
    XL.Selection.ColumnWidth = 0.25
    XL.Cells.EntireRow.AutoFit               
    XL.Selection.RowHeight = 2.25
    XL.ActiveWindow.ScrollRow = 1
    XL.ActiveWindow.ScrollColumn = 1
 
    XL.Selection.FormatConditions.AddColorScale 3
 
'XL.ActiveWorkbook.SaveAs OutFile & ".xlsx" , 51
'XL.ActiveWorkbook.Saved = True
'XL.ActiveWindow.Close
'XL.Quit
 
Next
0
2616 / 546 / 109
Регистрация: 21.03.2012
Сообщений: 1,051
23.03.2017, 14:25 10
Ну, используйте что-нибудь такое:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
XL.Columns("A:A").Select
    XL.Selection.Delete Shift = xlToLeft
    XL.Rows("1:1").Select
    XL.Selection.Delete Shift = xlUp
    XL.Selection.Delete Shift = xlUp
    XL.Cells.Select
    XL.Range("HO208").Activate
    XL.Selection.ColumnWidth = 0.25
    XL.Cells.EntireRow.AutoFit               
    XL.Selection.RowHeight = 2.25
    XL.ActiveWindow.ScrollRow = 1
    XL.ActiveWindow.ScrollColumn = 1
 
    XL.Selection.FormatConditions.AddColorScale 3
    XL.Selection.FormatConditions(XL.Selection.FormatConditions.Count).SetFirstPriority
    XL.Selection.FormatConditions(1).ColorScaleCriteria(1).Type = 1
    With XL.Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .ThemeColor = 7
        .TintAndShade = 0.5
    End With
    XL.Selection.FormatConditions(1).ColorScaleCriteria(3).Type = 2
    With XL.Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 255
        .TintAndShade = 0
    End With
Вы всегда можете подобрать приемлемый вариант, поэкспериментировав с настройками условного форматирования при включенном режиме записи макроса.
После завершения оформления остановите запись и посмотрите получившийся код.
Учтите, что все именованные константы объектной модели Excel надо заменить на их числовые значения. Например, константу xlConditionValueLowestValue надо заменить на значение 1.
0
0 / 0 / 0
Регистрация: 01.02.2017
Сообщений: 6
23.03.2017, 16:25  [ТС] 11
А чем заменить xlConditionValuePercentile и xlConditionValueHighestValue ?
0
2616 / 546 / 109
Регистрация: 21.03.2012
Сообщений: 1,051
24.03.2017, 05:32 12
Tromal5, всё необходимое можно легко найти с помощью инструмента Object Browser.
0
Миниатюры
По очереди открывать каждый CSV-файл, запускать макрос и сохранять этот файл в формате XLSX  
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
24.03.2017, 05:32

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

Если я пишу программу на языке Delphi в блокноте, то в каком формате нужно сохранять файл?
если я пишу программу на языке Delphi в блокноте , то в каком формате нужно сохранять ?

Как программно сохранять файл xls в текстовом формате, и всё время в одно и тоже место?
Коллеги, доброго времени суток! Помогите, как програмно сохранять файл *.xls в текстовом формате и...

ПУСТЬ это текстовый файл, который содержит НЕСКОЛЬКО ЦЕЛЫХ ЧИСЕЛ. ОТКРЫТЬ этот текстовый файл и КАЖДЫЙ С ЧИСЕЛ вознести В КУБ.
ПУСТЬ это текстовый файл, который содержит НЕСКОЛЬКО ЦЕЛЫХ ЧИСЕЛ. ОТКРЫТЬ этот текстовый файл и...

Java Server-Client. Сервер должен сохранять время запроса, сам запрос(сообщение) и IP, с которого пришел запрос в CSV файл
Работал на одном компе, так что адрес локальный. Проблема в том, что мой CSV файл пустой. Java...

Макрос: запускать таймер каждый раз в разных ячейках
Добрый день!Кто может помочь,нужен макрос,который запускает таймер каждый раз в разных...

Найти файл, и в папку где лежит этот файл скопировать другой файл)
Задача описана в названии, но повторюсь. Надо найти папку с известным названием файла (123.txt),...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.