Добрый вечер уважаемые. Есть задача, для меня сложная. т.к. я далек от Microsoft Excel как Арктика от Антарктиды. В файле две колонки, "А" и "В". В колонке "А" название товара, в колонке "В" его описание ~600 символов, всего 2700 строк в таблице. Одна строка на товар. Не могли бы вы подсказать готовый макрос, чтобы сохранить каждую строку в папку, в отдельный .txt файл. путь к папке: C:\Liga. Т.е. в этой папке у меня должно оказаться 2700 .txt файлов, с названием товара в качестве имени файла и с описанием товара внутри файла.
Ну вот, объяснил вроде бы подробно. Понимаю, что для знающего человека это "первый класс, вторая четверть", но я этого делать не умею, надеюсь на вашу помощь.
Sub Мяу()
Dim txtTmp$, sFileName$, sPath$, i&
Dim FSO As Object, TextStream As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
sPath = "c:\Liga\\"
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
txtTmp = Cells(i, 2)
sFileName = Cells(i, 1)
Set TextStream = FSO.CreateTextFile(sPath & Replace_symbols(sFileName) & ".txt", True)
TextStream.Write txtTmp
TextStream.Close
Application.StatusBar = "Сохранён файл №" & i & ", для товара " & sFileName
Next
Application.StatusBar = False
End Sub
Public Function Replace_symbols(ByVal sStr As String) As String
Dim i As Byte
Dim St As String
St = "*/\:?|""""<>~"
For i = 1 To Len(St)
sStr = Replace(sStr, Mid(St, i, 1), "_")
Next
Replace_symbols = sStr
End Function
Но если в названии будут запрещённые символы - может быть ошибка! Поэтому добавил ещё функцию.
Подскажите еще вот что, при попытке запуска макроса выскакивает окошко с надписью "Permission denied". Как ее побороть? Использование макросов я включил, но окошко все равно лезет.
Hugo, все получилось! Но вот такая беда. путь в макросе я заменил на: "C:\Users\Andrew\SkyDrive\Liga". Соответственно папку Liga я перекинул в папку SkyDrive. но смотрите, на скрин, что получается. все работает, но файлы в папку не попали, а стали в рядом в папку SkyDrive, при этом к имени файла добавилось имя нужной папки.
Sub Мяу()
Dim sPath$, i&
sPath = "c:\Liga" & Chr(92)
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Open sPath & Replace_symbols(Cells(i, 1)) & ".txt" For Output As #1
Print #1, CStr(Cells(i, 2));
Close #1
Next
End Sub
StoreKeeper написал: но файлы в папку не попали, а стали в рядом
это не моя вина, а движка форума - в коде написано было sPath = "c:\Liga", а движок слэш скушал... Алексей в этих делах дока, он знает как движок обмануть... Вообще-то я тоже сегодня уже сталкивался, но уже забыл...
P.S. И я бы всёж добавил Application.StatusBar - чтоб знать что не висит.