Экспорт из Excel в txt

[KARUSHEV]

Всем привет!

Помогите подправить код:

Sub Макрос1()

Const defPath = "c:\temp\"  'Путь к папке для сохранения
Dim fileSaveName, rr As Range, n As Integer, i As Integer
If Dir(defPath, vbDirectory) = "" Then MkDir defPath
ChDir defPath
fileSaveName = Application.GetSaveAsFilename(Replace(ActiveWorkbook.Name, ".xls", ""), _
    "Text Files (*.txt), *.txt", , " ")
If fileSaveName <> False Then
    Open fileSaveName For Output As #1
    For Each rr In ActiveSheet.UsedRange.Rows
        n = rr.Cells.Count
        For i = 1 To n - 1
            Print #1, rr.Cells(i).Text; vbTab;
        Next
        Print #1, rr.Cells(n)
    Next
Close #1
End If
End Sub

Нужно, чтобы путь к папке для сохранения, был таким же как у исходного Excel файла и название txt файла такое же, как у Excel файла.

[doober]

Можно так

Path = Replace(ThisWorkbook.FullName, ".xls", ".txt")

Path = Replace(ActiveWorkbook.FullName, ".xls", ".txt")

[Казанский]

Нужно, чтобы путь к папке для сохранения, был таким же как у исходного Excel файла и название txt файла такое же, как у Excel файла.
А зачем тогда запрашивать название?
И можно обойтись без вложенного цикла, хотя это не будет быстрее:

Sub Макрос1()

Dim fn$, rr As Range
fn = ActiveWorkbook.FullName
fn = Left$(fn, InStrRev(fn, ".")) & "txt"
Open fn For Output As #1
For Each rr In ActiveSheet.UsedRange.Rows
    Print #1, Join(Application.Transpose(Application.Transpose(rr.Value)), vbTab)
Next
Close #1
End Sub

[Казанский]

Кстати, а почему бы просто не сохранить книгу как txt?
Запишите макрорекордером это действие.
Результат, конечно, может быть немного другим - если Usedrange не начинается с А1 или если строки имеют разную длину. Но, может, это неважно?

[KARUSHEV]

Выдает ошибку: "run-time error '13' type mismatch". У меня языковые стандарты и форматы Английский-Великобритания, пробовал менять на Русский, та же ошибка.

Не работает эта строка:

    Print #1, Join(Application.Transpose(Application.Transpose(rr.Value)), vbTab)

[Казанский]

Видимо, текст в ячейках длиннее 256 символов.
Все, я разочаровался в этом методе
А сохранять книгу или лист как TXT не пробовали?

[KARUSHEV]

Пробовал этот макрос в новом файле, забивал в один столбец цифры. Может скините свой файл Excel с работающим макросом?

Хочу сделать в листе кнопочку SaveAsTxt, чтобы в итоге у меня сохранялся лист, на котором расположена кнопка в файл TXT, с названием книги и в ту же папку. Надоедает делать одни и те же действия, поэтому и хочу такой макрос