Макрос для передачи персанальных данных

[Pavel55]

Угу, Дим. Спасибо.
Вот немного изменил первый код и добавил вторую процедуру по копированию информации из текстового файла в Excel

Переносим данные в текстовые файла

Sub Создат_текстовые_файлы()
    Dim FSO As Object, TextStream As Object, rCell As Range, iArr, iFullName As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each rCell In Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If rCell <> "" Then
            iFullName = "C:\Temp\" & rCell & " " & rCell.Offset(, 1) & " " & rCell.Offset(, 2) & ".txt"
            Set TextStream = FSO.OpenTextFile(iFullName, 8, True, -2)
            iArr = Range(Cells(rCell.Row, "A"), Cells(rCell.Row, "J"))
            TextStream.WriteLine Join(Application.Transpose(Application.Transpose(iArr)), ";")
            TextStream.Close
        End If
    Next rCell
    MsgBox "Текстовые файлы созданы (информация добавлена)!", 64, ""
End Sub

Копируем данные из текстового файла на лист Excel

Sub Взять_инфо_из_файла()
    Dim iFullName As String, FSO As Object, TextStream As Object, iArr As Variant, iLastRow As Long

    Set FSO = CreateObject("Scripting.FileSystemObject")
    iFullName = "C:\Temp\1111 111-2 111-3.TXT"
    Set TextStream = FSO.OpenTextFile(iFullName, 1)
    Do While Not TextStream.AtEndOfStream
        iLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        iArr = Split(TextStream.ReadLine, ";")
        Range(Cells(iLastRow, 1), Cells(iLastRow, UBound(iArr) + 1)) = iArr
    Loop
    TextStream.Close
    MsgBox "Данные из текстового файла скопированы!", 64, ""
End Sub

P.S. Evroclidon, в коде использован объект FileSystemObject. С его помощью мы и записываем данные в текстовые файлы и считываем данные из них. У этого объекта много методов и свойств, почитайте про них, например, тут http://www.excel-team.ru/FileSystemObject.php

[mihali4]

Для ТС, для "персаны" (Макрос для передачи персанальных данных)...
Ради бога, не пишите так в дипломе.
Не дай бог, попадется такой, как я - заставит диктант писать и выгонит к едрене фене с двойкой...

[Evroclidon]

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

Кардинально измениться код. Необходимо отрыть определённые файлы или они заранее неизвестны? Можно выбирать файлы через диалоговое окно или просто записать в массив имена файлов и затем их обрабатывать по очереди.
Записывать данные из .txt-файлов как? Разделитель известен? Записывать новую книгу или уже имеющуюся? Все файлы на один лист?

Мы создаем файлы например в одном городе, передаем их в другой, там их вбивают в эксель макросом, а нам передают такие же файлы, с другими именами или этиже но с дополненной информацией, примерно так. Файлов может быть и 100 и 200...Как мне объяснили, крипто система позволяет передавать только в txt.

[EducatedFool]

Не совсем понял, что требуется, но не проще ли сделать так:

Вместо всех этих загадочных макросов с CreateObject("Scripting.FileSystemO bject")
используем сохранение в формате CSV (можно сохранить файл с расширением TXT вместо CSV)

Для создания файла TXT достаточно будет одной строки кода:
ActiveWorkbook.SaveAs ИмяФайла, xlCSV

Так же просто будет реализовываться и загрузка TXT в excel:
Workbooks.Open ИмяФайла
или так
Workbooks.OpenText ИмяФайла


PS: При необходимости шифрования файлов TXT (после их создания штатными средствами Excel) можно открывать получившиеся файлы как TextStream, шифровать считанный текст, и записывать его обратно в файл.
Перед открытием файла на другом компе (через Workbooks.Open) производить обратную операцию.

[Evroclidon]

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

Не совсем понял, что требуется, но не проще ли сделать так:

Вместо всех этих загадочных макросов с CreateObject("Scripting.FileSystemO bject")
используем сохранение в формате CSV (можно сохранить файл с расширением TXT вместо CSV)

Для создания файла TXT достаточно будет одной строки кода:
ActiveWorkbook.SaveAs ИмяФайла, xlCSV

Так же просто будет реализовываться и загрузка TXT в excel:
Workbooks.Open ИмяФайла
или так
Workbooks.OpenText ИмяФайла


PS: При необходимости шифрования файлов TXT (после их создания штатными средствами Excel) можно открывать получившиеся файлы как TextStream, шифровать считанный текст, и записывать его обратно в файл.
Перед открытием файла на другом компе (через Workbooks.Open) производить обратную операцию.

Ты прав, но в нашем случаи надо не просто документ передать, а четко разбить по фамилиям, и работать с отдельными людьми из электронных документов. По этому, такой перевод в txt актуален.

[Evroclidon]

iArr = Range(Cells(rCell.Row, "A"), Cells(rCell.Row, "J"))
TextStream.WriteLine Join(Application.Transpose(Applicat ion.Transpose(iArr)), ";")
TextStream.Close


Тут бы желательно, как то переменную сделать, что бы макрос сам определял пустую ячейку, для того что бы документ ушел, с неполыми данными, а верулся к примеру с полными.

[Evroclidon]

Sub Взять_инфо_из_файла()
Dim iFullName As String, FSO As Object, TextStream As Object, iArr As Variant, iLastRow As Long

Set FSO = CreateObject("Scripting.FileSystemO bject")
iFullName = "C:\Temp\1111 111-2 111-3.TXT"
Set TextStream = FSO.OpenTextFile(iFullName, 1)
Do While Not TextStream.AtEndOfStream
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
iArr = Split(TextStream.ReadLine, ";")
Range(Cells(iLastRow, 1), Cells(iLastRow, UBound(iArr) + 1)) = iArr
Loop
TextStream.Close
MsgBox "Данные из текстового файла скопированы!", 64, ""
End Sub


пытаюсь разобраться, в этом, но пока не выходит, не выводит он данные в эксель.

[Pavel55]

А у вас есть файл с именем "1111 111-2 111-3.TXT" в папке C:\Temp\ ?
Подставьте своё имя файла.

В нём должны быть данные разделённые точкой с запятой, типа:

Иванова;Марина;Александровна;1945 г/р;ул. Мурманская, д.3, кв.25

[Evroclidon]

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

А у вас есть файл с именем "1111 111-2 111-3.TXT" в папке C:\Temp\ ?
Подставьте своё имя файла.

В нём должны быть данные разделённые точкой с запятой, типа:

Иванова;Марина;Александровна;1945 г/р;ул. Мурманская, д.3, кв.25

создал. ошибку на этой страке выбивает:
Set FSO = CreateObject("Scripting.FileSystemO bject")

[Pavel55]

Откройте файл с макросом, зайдите в редактор VBA (Alt+F11), зайдите в меню Tools - References..., откроется окошко, найдите в этом окошке библиотеку Microsoft Scripting Runtime, поставьте галочку слева напротив неё и нажмите ОК. После этого код должен заработать