По очереди открывать каждый 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.

Новые блоги и статьи Все статьи Все блоги /
Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .	SDL3 для Web (WebAssembly): Работа со звуком через SDL3_mixer 8Observer8 08.02.2026 Содержание блога Пошагово создадим проект для загрузки звукового файла и воспроизведения звука с помощью библиотеки SDL3_mixer. Звук будет воспроизводиться по клику мышки по холсту на Desktop и по. . .	SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств 8Observer8 07.02.2026 Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .	SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .
Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .	SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .

@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