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

@Tromal5 · Регистрация: 01.02.2017

Студворк — интернет-сервис помощи студентам

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

У меня есть много файлов в папке С:\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 чтобы значения оставались в своих ячейках?

@Dmitrii · 02.02.2017, 10:08

Сообщение от 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

@Tromal5 · 02.02.2017, 12:21 **[ТС]**

Попробовал запустить на рабочем компе, получается совсем странно:
Исходный csv:

Code
1
2
3
4
       А      В      С      D
1:  Пусто | 3,15 | 5,67 | 4,85 |
2:  Пусто | 5,66 | 9,99 | 2,25 |
3:  Пусто | 1,45 | 5,08 | 6;53 |

Открывается методом Open:

Code
1
2
3
4
        А          В      С      D
1:      3;     | 15;5 | 67;4 |  85  |
2:      5;     | 66;9 | 99;2 |  25  |
3:      1;     | 45;5 | 08;6 |  53  |

Открывается методом OpenText:

Code
1
2
3
4
               А            В       С       D
1:      3;15;5;67;4;85  | Пусто | Пусто | Пусто | 
2:      5;66;9;99;2;25  | Пусто | Пусто | Пусто | 
3:      1;45;5;08;6;53  | Пусто | Пусто | Пусто |

@Dmitrii · 02.02.2017, 12:30

Tromal5, приложите, пожалуйста, исходный CSV-файл (если не секрет, конечно).

@Tromal5 · 02.02.2017, 14:26 **[ТС]**

В архиве исходный csv и конечный результат xlsx

@Dmitrii · 02.02.2017, 21:24

В вашем случае открывать 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

@Tromal5 · 23.03.2017, 11:09 **[ТС]**

Спасибо за помощь, сейчас файл открывается и сохраняется как нужно. Но так как этот файл будет использоваться на разных компьютерах, то макрос нужно вписать внутри кода.С этим у меня небольшая проблема.

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

@Dmitrii · 23.03.2017, 12:05

Оператор в строке 28 должен выглядеть так:

Visual Basic
1
XL.Selection.FormatConditions.AddColorScale 3

@Tromal5 · 23.03.2017, 13:03 **[ТС]**

Спасибо, помогло. Оставил только эту строчку, остальные убрал, так как они все равно не дают нужный мне результат.
Сейчас код работает, но есть один недостаток.
Когда он раскрашивает ячейки, то он меньшие значения красит в красный, а большие в зеленый. Впринципе можно оставить и так, но так как это тепловизионный снимок, то гарячие места хотелось бы видеть красным, а не зеленым.

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

@Dmitrii · 23.03.2017, 14:25

Ну, используйте что-нибудь такое:

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.

@Tromal5 · 23.03.2017, 16:25 **[ТС]**

А чем заменить xlConditionValuePercentile и xlConditionValueHighestValue ?

@Dmitrii · 24.03.2017, 05:32

Tromal5, всё необходимое можно легко найти с помощью инструмента Object Browser.

Новые блоги и статьи Все статьи Все блоги /
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .

@Dmitrii 2619 / 549 / 109 Регистрация: 21.03.2012 Сообщений: 1,051
	02.02.2017, 12:30
	Tromal5, приложите, пожалуйста, исходный CSV-файл (если не секрет, конечно). 0

@Tromal5 0 / 0 / 0 Регистрация: 01.02.2017 Сообщений: 6
	23.03.2017, 16:25 [ТС]
	А чем заменить xlConditionValuePercentile и xlConditionValueHighestValue ? 0

@Dmitrii 2619 / 549 / 109 Регистрация: 21.03.2012 Сообщений: 1,051
	24.03.2017, 05:32
	Tromal5, всё необходимое можно легко найти с помощью инструмента Object Browser. Миниатюры 0