Работа с .txt

[armagedon_atyrau]

Здравствуйте всем!!!
Нужен помощь.

Function GetFolderPath(Optional ByVal Title As String = "Âûáåðèòå ôàéë", Optional ByVal InitialPath As String) As String
GetFolderPath = "": PS = Application.PathSeparator
With Application.FileDialog(msoFileDialo gOpen)
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
.FilterIndex = 6
If .Show = -1 Then GetFolderPath = .SelectedItems(1):
If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath
End With
End Function

Sub Load_TXT()
Dim i As Integer
Application.ScreenUpdating = False
Set oFSO = CreateObject("Scripting.FileSystemO bject")
Dim s, t, rez As String
On Error GoTo 6
Set txt = oFSO.OpenTextFile(GetFolderPath, 1, True)

Дальше хочу что бы с начала текста скопировал все пока не встретит три раза "&" символа

Заранее благодарен

[EducatedFool]

Для чтения из файла можно использовать эту функцию: http://excelvba.ru/code/txt

Ваш код будет выглядеть так:

Function GetFileName(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal MyFilter As String = "Текстовые файлы (*.txt),") As String
    res = Application.GetOpenFilename(MyFilter, , Title, "Открыть")
    If VarType(res) = vbBoolean Then GetFileName = "" Else GetFileName = res
End Function

Function ReadTXTfile(ByVal filename As String) As String
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close
    Set ts = Nothing: Set fso = Nothing
End Function

Sub Main()
    ИмяФайла = GetFileName ' запрашиваем имя файла
    If ИмяФайла = "" Then Exit Sub ' выход, если пользователь отказался от выбора файла
    txt = ReadTXTfile(ИмяФайла)    ' считываем всё содержимое файла в переменную TXT
    pos = InStr(1, txt, "&&&")    ' ищем позицию подстроки  "&&&"
    If pos > 1 Then txt = Left(txt, pos - 1)    ' если нашли "&&&", то обрезаем строку
    MsgBox txt
End Sub