Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Запись данных в текстовый файл и последующее его сохранение - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Запись данных в текстовый файл и последующее его сохранение (Макросы/Sub)
Запись данных в текстовый файл и последующее его сохранение
Red_Sloth Дата: Среда, 10.02.2016, 18:14 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте!

Необходимо написать код, который будет бегать по листу Excel'я, данные записывать в текстовый файл, и сохранять текстовый файл в туже директорию, где лежит файл с макросом.
Написал вот такой код:
[vba]
Код
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    v = ThisWorkbook.Path
    Set objFile = objFSO.CreateTextFile(v & ActiveSheet.Name & ".txt")
    For i = 2 To Sheets("sec").UsedRange.Rows.Count
      For j = 4 To Sheets("sec").UsedRange.Columns.Count
        If Sheets("sec").Cells(i, j).Value <> "" Then
          objFile.writeline (Sheets("sec").Cells(i, j).Value)
        End If
      Next j
    Next i
  MsgBox ("Созданный файл сохранен: " & ThisWorkbook.Path)
[/vba]

Однако, файл не сохраняется. Причем я вижу, что директория в ThisWorkbook.Path отображается верно. Вариант с ActiveWorkbook.Path тоже пробовал, не помогло.
Подскажите пожалуйста, в чем может быть проблема!
 
Ответить
СообщениеЗдравствуйте!

Необходимо написать код, который будет бегать по листу Excel'я, данные записывать в текстовый файл, и сохранять текстовый файл в туже директорию, где лежит файл с макросом.
Написал вот такой код:
[vba]
Код
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    v = ThisWorkbook.Path
    Set objFile = objFSO.CreateTextFile(v & ActiveSheet.Name & ".txt")
    For i = 2 To Sheets("sec").UsedRange.Rows.Count
      For j = 4 To Sheets("sec").UsedRange.Columns.Count
        If Sheets("sec").Cells(i, j).Value <> "" Then
          objFile.writeline (Sheets("sec").Cells(i, j).Value)
        End If
      Next j
    Next i
  MsgBox ("Созданный файл сохранен: " & ThisWorkbook.Path)
[/vba]

Однако, файл не сохраняется. Причем я вижу, что директория в ThisWorkbook.Path отображается верно. Вариант с ActiveWorkbook.Path тоже пробовал, не помогло.
Подскажите пожалуйста, в чем может быть проблема!

Автор - Red_Sloth
Дата добавления - 10.02.2016 в 18:14
Manyasha Дата: Среда, 10.02.2016, 18:31 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2133
Репутация: 867 ±
Замечаний: 0% ±

Excel 2010, 2016
Red_Sloth, здравствуйте. Он у Вас сохраняется в родительскую папку.
[vba]
Код
v = ThisWorkbook.Path & "\"
    Set objFile = objFSO.CreateTextFile(v & ActiveSheet.Name & ".txt")
[/vba]
вот так попробуйте


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеRed_Sloth, здравствуйте. Он у Вас сохраняется в родительскую папку.
[vba]
Код
v = ThisWorkbook.Path & "\"
    Set objFile = objFSO.CreateTextFile(v & ActiveSheet.Name & ".txt")
[/vba]
вот так попробуйте

Автор - Manyasha
Дата добавления - 10.02.2016 в 18:31
Udik Дата: Среда, 10.02.2016, 18:40 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Однако, файл не сохраняется


файл при закрытии сохраняется, а я не нашел этой строчки в приведённом коде
[vba]
Код

Public Sub test()
Dim rng1 As Range, c As Range

Set rng1 = ActiveSheet.UsedRange
Set fs = CreateObject("Scripting.FileSystemObject")
Set f1 = fs.CreateTextFile("d:\testfile.txt", True)
For Each c In rng1
    If c.Value <> "" Then f1.WriteLine (c.Value)

Next
f1.Close '!!!
End Sub

[/vba]
[p.s.]в моём коде сохранение в корень d
К сообщению приложен файл: 0t.xlsm(21.7 Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Среда, 10.02.2016, 18:46
 
Ответить
Сообщение
Однако, файл не сохраняется


файл при закрытии сохраняется, а я не нашел этой строчки в приведённом коде
[vba]
Код

Public Sub test()
Dim rng1 As Range, c As Range

Set rng1 = ActiveSheet.UsedRange
Set fs = CreateObject("Scripting.FileSystemObject")
Set f1 = fs.CreateTextFile("d:\testfile.txt", True)
For Each c In rng1
    If c.Value <> "" Then f1.WriteLine (c.Value)

Next
f1.Close '!!!
End Sub

[/vba]
[p.s.]в моём коде сохранение в корень d

Автор - Udik
Дата добавления - 10.02.2016 в 18:40
al-Ex Дата: Четверг, 11.02.2016, 11:43 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010

[vba]
Код

Public Sub test()
Dim rng1 As Range, c As Range
Set rng1 = ActiveSheet.UsedRange
Set fs = CreateObject("Scripting.FileSystemObject")
Set f1 = fs.CreateTextFile("d:\testfile.txt", True)
For Each c In rng1
    If c.Value <> "" Then f1.WriteLine (c.Value)
Next
f1.Close '!!!
End Sub
[/vba]

Воистину: "краткость сестра таланта" thumb


Сообщение отредактировал al-Ex - Четверг, 11.02.2016, 12:23
 
Ответить
Сообщение

[vba]
Код

Public Sub test()
Dim rng1 As Range, c As Range
Set rng1 = ActiveSheet.UsedRange
Set fs = CreateObject("Scripting.FileSystemObject")
Set f1 = fs.CreateTextFile("d:\testfile.txt", True)
For Each c In rng1
    If c.Value <> "" Then f1.WriteLine (c.Value)
Next
f1.Close '!!!
End Sub
[/vba]

Воистину: "краткость сестра таланта" thumb

Автор - al-Ex
Дата добавления - 11.02.2016 в 11:43
televnoy Дата: Воскресенье, 17.12.2017, 19:34 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 112
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Работают макросы. А как не перезаписывать файл, а дописывать значениями?


О-па! 0_o
 
Ответить
СообщениеРаботают макросы. А как не перезаписывать файл, а дописывать значениями?

Автор - televnoy
Дата добавления - 17.12.2017 в 19:34
alex77755 Дата: Понедельник, 18.12.2017, 05:58 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 357
Репутация: 63 ±
Замечаний: 0% ±

и создавать и дописывать намного проще дедовским способом не привлекая тяжелую артиллерию FSO
[vba]
Код
    path = ActiveWorkbook.path & "\test.txt"
    Open path For Append As 1
        Print #1, Now
    Close 1
[/vba]


Могу помочь в VB6, VBA
Alex77755@mail.ru
 
Ответить
Сообщениеи создавать и дописывать намного проще дедовским способом не привлекая тяжелую артиллерию FSO
[vba]
Код
    path = ActiveWorkbook.path & "\test.txt"
    Open path For Append As 1
        Print #1, Now
    Close 1
[/vba]

Автор - alex77755
Дата добавления - 18.12.2017 в 05:58
televnoy Дата: Понедельник, 18.12.2017, 06:50 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 112
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
alex77755, Создается, дописывается - но только время и дата, но не данные столбца (листа)
Нашел чтобы дописывал данные. Переделал, чтобы записывал с первого столбика только данные. И использовал [vba]
Код
For Append
[/vba]
[vba]
Код
Sub WriteFile()

ThisFile = ThisWorkbook.Path & Application.PathSeparator & "Results.txt"

Open ThisFile For Append As #1
FinalRow = Range("A65536").End(xlUp).Row
' Записать файл
For j = 1 To FinalRow
Print #1, Cells(j, 1).Value
Next j
Close #1
MsgBox ThisFile & " completed."
End Sub
[/vba]


О-па! 0_o

Сообщение отредактировал televnoy - Понедельник, 18.12.2017, 06:53
 
Ответить
Сообщениеalex77755, Создается, дописывается - но только время и дата, но не данные столбца (листа)
Нашел чтобы дописывал данные. Переделал, чтобы записывал с первого столбика только данные. И использовал [vba]
Код
For Append
[/vba]
[vba]
Код
Sub WriteFile()

ThisFile = ThisWorkbook.Path & Application.PathSeparator & "Results.txt"

Open ThisFile For Append As #1
FinalRow = Range("A65536").End(xlUp).Row
' Записать файл
For j = 1 To FinalRow
Print #1, Cells(j, 1).Value
Next j
Close #1
MsgBox ThisFile & " completed."
End Sub
[/vba]

Автор - televnoy
Дата добавления - 18.12.2017 в 06:50
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Запись данных в текстовый файл и последующее его сохранение (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!