Выгрузка из Эксель в текстовый документ без разделителей...

[doober]

Не может быть.еще раз проверил,файл создается в папке с файлом.Я путь к вашей папке закоментил

Public Sub Example_Compas()
Dim sl As String, sl1 As String
    Dim myPath As String, myName As String
  '  myPath = "N:\_КЛИРИНГ\Лимиты\КОмпас\" 'Путь к файлу уберите апостроф и укажите правильный путь к папке для вывода файла
    myName = "Compas.dat"

[Zhiltsov]

Путь проверил, все верно, а файл не формируется.
Я тут кое что сам наваял, точнее слепил из образцов кода на этом форуме(спасибо форумчанам)
Сохраняется у меня файл по такому коду:
Sub SaveTXT()

Dim myPath As String, myName As String, myName1 As String, x As String, ts: Application.ScreenUpdating = False
myPath = "N:\_КЛИРИНГ\COMPAS+\DAT\" 'Ваш путь
myName = "ORS_limits_refresh" 'Ячека, содержащая имя файла
myName = myPath & myName & "_" & Format(Now, "yyyymmdd_hhmmss") & ".dat"
Sheets("ORS_limits_refresh").Activa te: Application.ScreenUpdating = False
ActiveSheet.Copy: ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
ActiveWorkbook.SaveAs Filename:=myName, FileFormat:=xlText: ActiveWorkbook.Close False
End Sub

Затем заменяются символы в последнем созданом файле в папке по такому коду:
Sub FindFiles()
'Имя файла
Dim sFileName As String
'Путь к папке с файлами
Dim sPath As String: sPath = "N:\_КЛИРИНГ\COMPAS+\DAT\"
'Маска для файлов
Dim sMask As String: sMask = "*.dat"
'Сообщение
Dim sMsg As String
Dim ar() As String
Dim x As String
Dim sName As String
Dim ts
ReDim ar(0)

sFileName = Dir(sPath & sMask)
Do While Len(sFileName) > 0
ar(UBound(ar)) = sFileName
sMsg = sMsg & sFileName & vbCrLf
sFileName = Dir
If Len(sFileName) <> 0 Then ReDim Preserve ar(UBound(ar) + 1)
Loop
'Сортировка методом пузырька
Dim i As Integer, j As Integer, sTmp As String
For i = 0 To UBound(ar)
For j = 0 To UBound(ar) - 1 - i
If FileDateTime(sPath & ar(j)) < FileDateTime(sPath & ar(j + 1)) Then
sTmp = ar(j)
ar(j) = ar(j + 1)
ar(j + 1) = sTmp
End If
Next j
Next i
sName = ar(j)
Set ts = CreateObject("Scripting.FileSystemO bject").OpenTextFile(sPath & sName, 1)
x = ts.ReadAll: x = Application.Trim(Replace(x, Chr(9), Chr(16))): ts.Close
Set ts = CreateObject("Scripting.FileSystemO bject").OpenTextFile(sPath & sName, 2, True)
ts.Write x: ts.Close

Set ts = CreateObject("Scripting.FileSystemO bject").OpenTextFile(sPath & sName, 1)
x = ts.ReadAll: x = Application.Trim(Replace(x, Chr(16) & Chr(13), Chr(10))): ts.Close
Set ts = CreateObject("Scripting.FileSystemO bject").OpenTextFile(sPath & sName, 2, True)
ts.Write x: ts.Close
End Sub

Так вот в строке выделенной жирным я хочу чтобы два символа Chr(16) & Chr(13) заменялись на один Chr(10) а получается что он каждый из символов заменяет(наверное синтаксис другой я не знаю как прописать) И ещё надо чтобы в конце файла тож ставился символ Chr(10), тож пока не соображу как сделать.

[doober]

Возможно я ошибаюсь,но простой заменой проблему не решить.Ваш файл будет отличаться от разработчиков.У них ячейки как бы по парам объеденены.вы обратили на это внимание.поэтому я файл формировал непосредственно с таблицы

[Zhiltsov]

хм, не формируется файл и все. Может быть причиной тому Office2007?

[doober]

Нет.У меня в 2003 и 2007 работает все правильно.Попробуйте по шагам посмотреть работу макроса.Чудес не бывает.Может не можете его найти-отправили в космос

[alexandr7]

Доброго времени суток, дорогие форумчане. Помогите чайнику. Как сделать так, чтобы из определённого листа книги конкретный диапазон ячеек записывался в текстовый файл. Спасибо всем, кто откликнется.

[IgorGO]

передать в эту процедуру записываемый диапазон и имя файла, куда записать данные

Sub WriteRg2TXT(rg As Range, ByVal txt As String)
  Dim fso As Object, txtFL As Object, cell As Range
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set txtFL = fso.CreateTextFile(txt, True): txt = ""
  For Each cell In rg:  txt = txt & cell.Value:  Next
  txtFL.WriteLine txt:  txtFL.Close
End Sub

например 
Sub Test
  WriteRg2TXT [a2:b100], "c:\Textfile.txt"
end Sub

[alexandr7]

Сообщение от IgorGO

передать в эту процедуру записываемый диапазон и имя файла, куда записать данные

Sub WriteRg2TXT(rg As Range, ByVal txt As String)
  Dim fso As Object, txtFL As Object, cell As Range
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set txtFL = fso.CreateTextFile(txt, True): txt = ""
  For Each cell In rg:  txt = txt & cell.Value:  Next
  txtFL.WriteLine txt:  txtFL.Close
End Sub

например 
Sub Test
  WriteRg2TXT [a2:b100], "c:\Textfile.txt"
end Sub

Большое спасибо, а как сделать так, чтобы старые записи в этом текстовом файле сохранялись, а новые добавлялись в конец. И если Вас не затруднить, как сделать так, чтобы этот макрос запускался автоматически при открытии этого листа, а не при нажатии кнопки. Большое спасибо Вам за помощь!

[IgorGO]

Sub WriteRg2TXT(rg As Range, ByVal txt As String)
  Dim fso As Object, txtFL As Object, cell As Range
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Not fso.fileexists(txt) Then
    Set txtFL = fso.CreateTextFile(txt, True):  txtFL.Close
  End If
  Set txtFL = fso.OpenTextFile(txt, 8): txt = ""
  For Each cell In rg:  txt = txt & cell.Value:  Next
  txtFL.WriteLine txt:  txtFL.Close
End Sub

этот

Private Sub Worksheet_Activate()
  WriteRg2TXT [a1:b3], "c:\txtfl.txt"
End Sub

в модуль листа

[alexandr7]

Сообщение от IgorGO

Sub WriteRg2TXT(rg As Range, ByVal txt As String)
  Dim fso As Object, txtFL As Object, cell As Range
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Not fso.fileexists(txt) Then
    Set txtFL = fso.CreateTextFile(txt, True):  txtFL.Close
  End If
  Set txtFL = fso.OpenTextFile(txt, 8): txt = ""
  For Each cell In rg:  txt = txt & cell.Value:  Next
  txtFL.WriteLine txt:  txtFL.Close
End Sub

этот

Private Sub Worksheet_Activate()
  WriteRg2TXT [a1:b3], "c:\txtfl.txt"
End Sub

в модуль листа

Извините за назойливость, но чё-то я ни как не могу вставить( Если поможете, буду очень признателен. Диапазон ячеек q10:t11,h19. И совсем было-бы здорово, если бы в текстовый файл вместе с экспортом добавлялось текущее время. Спасибо за вашу отзывчивость!