Ребят, подскажите плиз. В VB практически ничего не понимаю (но доходчивый). Суть проблемы:
В некой папке имеется n файлов. Их много, более 1000. Так вот, нужно в указанный пользователем файл добавить информацию следущего типа:

имя файла1(без расширения и пути к нему)_содержание файла_затем должен идти переход на другую строку.
имя файла2(без расширения и пути к нему)_содержание файла_затем должен идти переход на другую строку.

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

Заранее спасибо

Не знаю сойдет ли: если я правильно понял, то тебе надо так:

кинь на форму Text1.Text и Text2.Text со свойством MultiLine = True и ScrollBar = Vertical

Код

Option Explicit Dim Txt As String Dim a As String Dim Str As String Dim Ln As Long Dim AllTxt As String Dim b As String Private Sub Command1_Click() a = Text1.Text If Text1.Text <> "" Then Text2.Text = Text2.Text & AllTxt Open (a) For Input As #1 Ln = Len(Text1.Text) Str = Text1.Text a = Left(Str, Ln - 4) Text2.Text = a Do Until EOF(1) Line Input #1, Txt AllTxt = AllTxt + Txt + vbCrLf Loop Close #1 Text2.Text = a & vbCrLf & AllTxt Close #1 Else: MsgBox "Введи путь и имя файла" End If End Sub Private Sub Text1_Change() b = Text1.Text If Command1.Value = True Then          Open (b) For Append As #1 Ln = Len(Text1.Text) Str = Text1.Text b = Left(Str, Ln - 4) Text2.Text = b Text2.Text = b & Text2.Text & vbCrLf & AllTxt     Close #1    End If End Sub

Наверное я коряво объяснил.
Итак еще раз о сути проблемы: в некотором каталоге имеется туча текстовых файлов.
Нужно чтобы программа автоматически скопировала текст из всех этих файлов в один. Т.е. должен получиться файл типа:

имя файла№1(без расширения и пути к нему)_содержание файла№1_затем должен идти переход на другую строку.
имя файла№2(без расширения и пути к нему)_содержание файла№2_затем должен идти переход на другую строку.
----------------------------------------------------------------------
имя файла№Х(без расширения и пути к нему)_содержание файла№X_затем должен идти переход на другую строку.

Т.е. слить все файлы из каталога в один файл автоматически.
Уф.

Вот написал тебе на быструю руку пример, как это можно сделать...

Код

Option Explicit Private Sub Command1_Click() Dim A() As Byte ' динамический массив Dim B() As Byte ' динамический массив Dim F1Name As String ' Имя первого файла Dim F2Name As String ' Имя второго файла Dim FRName As String ' Имя файла с результатом F1Name = App.Path & "\x1.txt" F2Name = App.Path & "\x2.txt" FRName = App.Path & "\xR.txt" Open F1Name For Binary Lock Read Write As #1     ReDim A(LOF(1)) ' создаем число элементов, соответствующее полному количеству байт файла     Get #1, 1, A ' Читаем файл в массив, начиная с первого байта Close #1 Open F2Name For Binary Lock Read Write As #1     ReDim B(LOF(1)) ' создаем число элементов, соответствующее полному количеству байт файла     Get #1, 1, B ' Читаем файл в массив, начиная с первого байта Close #1 Open FRName For Binary Lock Read Write As #1     Put #1, , cut(F1Name) ' пишем имя первого файла     Put #1, , A ' пишем массив A в файл     Put #1, , vbCrLf ' перенос строки     Put #1, , cut(F2Name) ' пишем имя второго файла     Put #1, , B ' пишем массив B в файл     Put #1, , vbCrLf ' перенос строки Close #1 End Sub Private Function cut(str As String) As String Dim i As Integer For i = 0 To Len(str)     If Left(Right(str, i), 1) = "\" Then         cut = Right(str, i - 1)         Exit For     End If Next cut = Split(cut, ".", , vbTextCompare)(0) & "_" End Function

В папке где сидит проект создай два файла x1.txt и x2.txt.

А в каком месте программы он переходит от одного файла к другому? (От 1 ко 2, От 2 к 3, от 3 к 4 и т.д. до последнего файла в каталоге) Может глупый вопрос, но я не вижу цикла...

Цитата(Nikolasha @ 7.5.2005, 15:11)

А в каком месте программы он переходит от одного файла к другому?

А это уж батенька сам Я тебе мыслю подкинул, а ты дорабатывай и улучшай... Или в раздел "Работа" пиши.

Понял не дурак - был дурак не понял. Огромное спасибо.
Будем решать проблему.

Цитата

Option Explicit Private Sub Command1_Click() Dim A() As Byte ' динамический массив Dim F1Name As String ' Имя первого файла Dim FRName As String ' Имя файла с результатом FRName = App.Path & "\xR.txt" With Application.FileSearch     .FileName = "*.txt"     .LookIn = App.Path     .Execute     For i = 1 To .FoundFiles.Count     F1Name = .FoundFiles(i)     Open F1Name For Binary Lock Read Write As #1     ReDim A(LOF(1)) ' создаем число элементов, соответствующее полному количеству байт файла     Get #1, 1, A ' Читаем файл в массив, начиная с первого байта     Close #1     Open FRName For Binary Lock Read Write As #1     Put #1, , cut(F1Name) ' пишем имя первого файла     Put #1, , A ' пишем массив A в файл     Put #1, , vbCrLf ' перенос строки     Close #1     Next i End With End Sub Private Function cut(str As String) As String Dim i As Integer For i = 0 To Len(str)     If Left(Right(str, i), 1) = "\" Then         cut = Right(str, i - 1)         Exit For     End If Next cut = Split(cut, ".", , vbTextCompare)(0) & "_" End Function

Следуя советам и проштудировав справку VB6 написал следующее. Однако хитрый компилятор что то там говорит невразумительное. Господа профи, если не сложно, объясните чего он хочет?

Во первых не "цитата", а "код".
Во вторых тебе нужно не VBA, а VB6.
В третьих читай тут:
http://www.vb-helper.com/howto_sorted_dir.html
C помощью их функции SortedFiles и вот этого куска кода

Код

Private Sub DirList_Change() Dim dir_path As String Dim files() As String Dim txt As String Dim i As Integer     ' Get the files.     dir_path = DirList.Path     If Right$(dir_path, 1) <> "\" Then dir_path = dir_path & "\"     dir_path = dir_path & "*"     files = SortedFiles(dir_path)     On Error GoTo NoFiles     For i = LBound(files) To UBound(files)         txt = txt & vbCrLf & files(i)     Next i ...

(который конечно надо немного подправить) ты обработаешь все файлы в нужной тебе директории.

Еще можешь тут почитать
Как скопировать файлы соответствующие маске
С помощью этого примера ты сможешь сначала только нужные файлы (*.txt например) скопировать в такую то директорию и потом их обработать.

Успехов!

ЭЭЭх.

То есть?
Если совсем не прет, то сделаю я тебе то, что надо. Тут уж делать то ничего и не осталось. Только сам понимаешь на быструю руку - вылизывать до блеска не буду.
Видно, что ты сам паришься (не то что некоторые - заваливаются типа "сделайте мне а?")...

Да, понимаешь я вроде и врубился во все. Но без учебника и справки далеко не уедешь, а спрашивать каждую функцию в Нете не удобно. Я пытался эту прогу в Паскале написать - а там чтение имени файлов до 8го символа(облом неимоверный). Сказали - пиши на VB.
Саму структуру я представляю, сначала описание двух динамических массивов(А и Б) потом Описание динамической строки(С) описание целого (Д) и еще по ходу дела какие-нибудь. Потом организую цикл (пока есть найденные файлы) и внутри еще один цикл, чтобы перебирать в массив Б имя и информация(с помощью функции или процедурки) в конце функции ты вызываешь встроенную функцию которя возвращает нажатия типа chr(10)+chr(13), чтобы он переходил на новою строку. Затем инф-ю из массива Б переписываем в массив А, который будет конечным файлом. Все. Но синтаксис.

Цитата

Если совсем не прет

Совсем не прет...

Ну вот сделал тебе на быструю руку (поэтому никому не показывай ):

Код

Option Explicit ' Use Quicksort to sort a list of strings. ' ' This code is from the book "Ready-to-Run ' Visual Basic Algorithms" by Rod Stephens. ' http://www.vb-helper.com/vba.htm Private Sub Quicksort(list() As String, ByVal min As Long, ByVal max As Long) Dim mid_value As String Dim hi As Long Dim lo As Long Dim i As Long     ' If there is 0 or 1 item in the list,     ' this sublist is sorted.     If min >= max Then Exit Sub     ' Pick a dividing value.     i = Int((max - min + 1) * Rnd + min)     mid_value = list(i)     ' Swap the dividing value to the front.     list(i) = list(min)     lo = min     hi = max     Do         ' Look down from hi for a value < mid_value.         Do While list(hi) >= mid_value             hi = hi - 1             If hi <= lo Then Exit Do         Loop         If hi <= lo Then             list(lo) = mid_value             Exit Do         End If         ' Swap the lo and hi values.         list(lo) = list(hi)         ' Look up from lo for a value >= mid_value.         lo = lo + 1         Do While list(lo) < mid_value             lo = lo + 1             If lo >= hi Then Exit Do         Loop         If lo >= hi Then             lo = hi             list(hi) = mid_value             Exit Do         End If         ' Swap the lo and hi values.         list(hi) = list(lo)     Loop     ' Sort the two sublists.     Quicksort list, min, lo - 1     Quicksort list, lo + 1, max End Sub ' Return an array containing the names of the ' files in the directory sorted alphabetically. Private Function SortedFiles(ByVal dir_path As String, Optional ByVal exclude_self As Boolean = True, Optional ByVal exclude_parent As Boolean = True) As String() Dim num_files As Integer Dim files() As String Dim file_name As String     file_name = Dir$(dir_path)     Do While Len(file_name) > 0         ' See if we should skip this file.         If Not _             (exclude_self And file_name = ".") Or _             (exclude_parent And file_name = "..") _         Then             ' Save the file.             num_files = num_files + 1             ReDim Preserve files(1 To num_files)             files(num_files) = file_name         End If         ' Get the next file.         file_name = Dir$()     Loop     ' Sort the list of files.     Quicksort files, 1, num_files     ' Return the list.     SortedFiles = files End Function Private Sub Command1_Click() Dim A() As Byte      ' динамический массив Dim FRName As String ' Имя файла с результатом Dim dir_path As String Dim files() As String Dim txt As String Dim i As Integer     FRName = App.Path & "\xR.txt"     ' Get the files.     dir_path = App.Path & "\"     If Right$(dir_path, 1) <> "\" Then dir_path = dir_path & "\"     dir_path = dir_path & "*.txt"     files = SortedFiles(dir_path)     Open FRName For Binary Lock Read Write As #2         For i = LBound(files) To UBound(files)             If "xR.txt" <> files(i) Then                 Open App.Path & "\" & files(i) For Binary Lock Read Write As #1                     ReDim A(LOF(1)) ' создаем число элементов, соответствующее полному количеству байт файла                     Get #1, 1, A    ' Читаем файл в массив, начиная с первого байта                 Close #1                      Put #2, , CStr(Left(files(i), Len(files(i)) - 4) & "_") ' пишем имя первого файла                 Put #2, , A      ' пишем массив A в файл                 Put #2, , vbCrLf ' перенос строки             End If         Next i     Close #2 End Sub

Половина (типа сортировки тебе нафиг не нужна), но выкидывать было лень...

Вот накатал тебе процедурки.

Код

Dim SearchPath As String Dim MaskOfFileName As String Dim FullOutputFileName As String Sub SplitFiles()    Dim NextFileName As String    Dim fnOUT As Integer    Dim cnt As Long ' эта переменная нужна только для подсчета кол-ва файлов, практического значения не несет        '-- проверим существование "выходного" файла    If Dir$(FullOutputFileName) <> "" Then       Dim ans As VbMsgBoxResult       ans = MsgBox("Такой файл уже есть. Переписать?", vbQuestion + vbYesNo)       If ans = vbYes Then          Kill FullOutputFileName ' убиваем файл       Else          Exit Sub       End If    End If        '-- если маску не указали, то в переменной MaskOfFileName будет "*"    MaskOfFileName = IIf(Len(Trim$(MaskOfFileName)) > 0, MaskOfFileName, "*")        '-- добавим "\" в конец пути, если его там не было    SearchPath = SearchPath & IIf(Right$(SearchPath, 1) = "\", "", "\")        '-- откроем файл для двоичной записи    fnOUT = FreeFile    Open FullOutputFileName For Binary Lock Write As fnOUT       '-- начинаем перебирать циклом все файлы в каталоге SearchPath       NextFileName = Dir$(SearchPath)       While NextFileName <> ""          '-- проверим соответствие имени файла с маской.          If NextFileName Like MaskOfFileName Then             WriteToFile fnOUT, SearchPath & NextFileName             cnt = cnt + 1          End If          NextFileName = Dir$       Wend    Close fnOUT    MsgBox "Обработано " & cnt & " файлов", vbInformation End Sub '-- я вынес эту процедуру из основной процедуры для того, '   чтобы потом можно было легче произвести оптимизацию записи, '   если это потребуется. '   Естественно ты можешь от нее избавиться и воткнуть целиком '   в то место кода, откуда она вызывается Sub WriteToFile(OutFileNumber As Integer, InputFileName As String)    Dim fnIN As Integer    Dim Buff() As Byte        fnIN = FreeFile    Open InputFileName For Binary Access Read As fnIN       ReDim Buff(LOF(fnIN) - 1)       Get fnIN, , Buff    Close fnIN    Put OutFileNumber, , InputFileName    Put OutFileNumber, , Buff    Put OutFileNumber, , vbNewLine End Sub

Здесь полный код, все что тебе нужно. (сто не нужно, выкидывай )
Проверял, все работает. Проверка по маске здесь строгая, то есть большие и мальенькие бквы различаются. Если исходные файлы у тебя большие, то тут можно оптимизировать. Напишу если надо. Пользуйся наздоровье
Добавлено @ 00:02
Вот я так и знал!!!

Прям как чувствовал, что пока буду сочинять код, придет cardinal и что нибудь уже выложит...

cardinal респект !!!