Страницы: 1
RSS
Как сохранить строки таблицы в отдельные .txt файлы.
 
Добрый вечер уважаемые.
Есть задача, для меня сложная. т.к. я далек от Microsoft Excel как Арктика от Антарктиды.
В файле две колонки, "А" и "В". В колонке "А" название товара, в колонке "В" его описание ~600 символов, всего 2700 строк в таблице. Одна строка на товар.  Не могли бы вы подсказать готовый макрос, чтобы сохранить каждую строку в папку, в отдельный .txt  файл. путь к папке: C:\Liga. Т.е. в этой папке у меня должно оказаться 2700 .txt файлов, с названием товара в качестве имени файла и с описанием товара внутри файла.

Ну вот, объяснил вроде бы подробно. Понимаю, что для знающего человека это "первый класс, вторая четверть", но я этого делать не умею, надеюсь на вашу помощь.

Заранее спасибо!
Изменено: StoreKeeper - 28.03.2015 22:45:43
 
Использовал готовое из http://www.excelworld.ru/forum/10-16633-1
Код
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


Но если в названии будут запрещённые символы - может быть ошибка! Поэтому добавил ещё функцию.
Изменено: Hugo - 28.03.2015 23:23:25
 
Вы имеете ввиду, если в названии, например, есть слеш?
Изменено: StoreKeeper - 28.03.2015 22:52:18
 
Да, слэш и не только - я там выше дополнил. Это для Виндовс, для других систем нужно бы расширить перечень.
 
Подскажите еще вот что, при попытке запуска макроса выскакивает окошко с надписью "Permission denied". Как ее побороть? Использование макросов я включил, но окошко все равно лезет.
 
Hugo, Спасибо, сейчас буду пробовать
 
Hugo, не подскажите, как победить окошко с надписью "Permission denied"? Макросы в книге разрешены, а оно лезет
 
 "Permission denied"  - переместите каталог c:\Liga\ куда-нибудь поглубже, а лучше на другой диск.
 
Hugo, вооот! сейчас попробую...
 
Добавил ещё идин символ и информацию о процессе - всёж 2700 это не быстро будет делаться.
 
Hugo, все получилось! Но вот такая беда. путь в макросе я заменил на: "C:\Users\Andrew\SkyDrive\Liga". Соответственно папку Liga я перекинул в папку SkyDrive. но смотрите, на скрин, что получается. все работает, но файлы в папку не попали, а стали в рядом в папку  SkyDrive, при этом к имени файла добавилось имя нужной папки.
 
А нафига здесь FSO? Без него проще ИМХО
Код
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
Изменено: Казанский - 28.03.2015 23:12:03
 
Казанский, Этот вариант сработал идеально + добавил функцию от макроса Hugo и все! Спасибо всем, реально выручили!  
 
Цитата
StoreKeeper написал:
но файлы в папку не попали, а стали в рядом
это не моя вина, а движка форума - в коде написано было sPath = "c:\Liga", а движок слэш скушал...
Алексей в этих делах дока, он знает как движок обмануть... :)
Вообще-то я тоже сегодня уже сталкивался, но уже забыл... :(

P.S. И я бы всёж добавил Application.StatusBar - чтоб знать что не висит.
Изменено: Hugo - 29.03.2015 13:18:51
 
Игорь, а попробуй писать два слэша подряд)
 
Попробовал - сработало! :)
 
Ура! У всех все получилось! Всем еще раз спасибо!
Страницы: 1
Наверх