Ответить на сообщение
Вернуться к теме
Вы отвечаете на сообщение:
ник: Lukas Без шапки, с небольшим форматированием:
Private rst As ADODB.Recordset Public Sub ReadFiles() Dim f As Integer With GetFiles() If .Count = 0 Then Exit Sub Else CreateRST For f = 1 To .Count ' Debug.Print .Item(f) ReadFile .Item(f) Next f CreateList rst.Close Set rst = Nothing End If End With End Sub Private Function GetFiles() As FileDialogSelectedItems With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True .Filters.Clear .Filters.Add "Текстовые файлы", "*.txt" .Show Set GetFiles = .SelectedItems End With End Function Private Sub ReadFile(FullPath As String) Const INSIDE_MARK As String = "1CClientBankExchange" Const DELIMITER As String = "=" Dim TextLine, row Dim i As Integer Open FullPath For Input As #1 Line Input #1, TextLine If TextLine = INSIDE_MARK Then 'Проверка на Внутренний признак файла обмена Do While Not EOF(1) Line Input #1, TextLine If TextLine <> vbNullString Then row = Split(TextLine, DELIMITER) Select Case row(0) Case "ВерсияФормата", "Кодировка", "Отправитель", "Получатель", "ДатаСоздания", "ВремяСоздания", "ДатаНачала", _ "ДатаКонца", "РасчСчет", "Документ", "СекцияРасчСчет", "ДатаНачала", "ДатаКонца", "РасчСчет", _ "НачальныйОстаток", "ВсегоПоступило", "ВсегоСписано", "КонечныйОстаток", "КонецРасчСчет", "КонецДокумента" Case Is = "СекцияДокумент" rst.AddNew rst.Fields("СекцияДокумент") = row(1) Case Is = "КонецФайла" rst.UpdateBatch rst.MoveFirst Case Else rst.Fields(row(0)) = row(1) End Select End If Loop Else MsgBox "Файл не содержит Внутренний признак файла обмена" End If Close #1 End Sub Private Sub CreateList() Dim wsh As Worksheet Dim i As Integer With Workbooks.Add Set wsh = .Worksheets(1) With wsh For i = 0 To rst.Fields.Count - 1 .Cells(1, i + 1) = rst.Fields(i).Name Select Case rst.Fields(i).Type Case adDate .Columns(i + 1).NumberFormat = "dd/mm/yyyy" Case adCurrency .Columns(i + 1).Style = "Comma" End Select Next i .Cells(2, 1).CopyFromRecordset rst .Cells.EntireColumn.AutoFit End With End With End Sub Private Sub CreateRST() Dim i As Integer Set rst = New ADODB.Recordset With rst With .Fields .Append "СекцияДокумент", adVarChar, 255 .Append "Номер", adVarChar, 255 .Append "Дата", adDate, 8, adFldIsNullable .Append "Сумма", adCurrency .Append "КвитанцияДата", adDate, 8, adFldIsNullable .Append "КвитанцияВремя", adDate, 8, adFldIsNullable .Append "КвитанцияСодержание", adVarChar, 255 .Append "ПлательщикСчет", adVarChar, 20 .Append "ДатаСписано", adDate, 8, adFldIsNullable .Append "Плательщик", adVarChar, 255 .Append "ПлательщикИНН", adVarChar, 12 .Append "Плательщик1", adVarChar, 255 .Append "Плательщик2", adVarChar, 255 .Append "Плательщик3", adVarChar, 255 .Append "Плательщик4", adVarChar, 255 .Append "ПлательщикРасчСчет", adVarChar, 20 .Append "ПлательщикБанк1", adVarChar, 255 .Append "ПлательщикБанк2", adVarChar, 255 .Append "ПлательщикБИК", adVarChar, 9 .Append "ПлательщикКорсчет", adVarChar, 20 .Append "ПолучательСчет", adVarChar, 20 .Append "ДатаПоступило", adDate, 8, adFldIsNullable .Append "Получатель", adVarChar, 255 .Append "ПолучательИНН", adVarChar, 12 .Append "Получатель1", adVarChar, 255 .Append "Получатель2", adVarChar, 255 .Append "Получатель3", adVarChar, 255 .Append "Получатель4", adVarChar, 255 .Append "ПолучательРасчСчет", adVarChar, 20 .Append "ПолучательБанк1", adVarChar, 255 .Append "ПолучательБанк2", adVarChar, 255 .Append "ПолучательБИК", adVarChar, 9 .Append "ПолучательКорсчет", adVarChar, 20 .Append "ВидПлатежа", adVarChar, 255 .Append "ВидОплаты", adVarChar, 2 .Append "Код", adVarChar, 25 .Append "НазначениеПлатежа", adVarChar, 255 .Append "НазначениеПлатежа1", adVarChar, 255 .Append "НазначениеПлатежа2", adVarChar, 255 .Append "НазначениеПлатежа3", adVarChar, 255 .Append "НазначениеПлатежа4", adVarChar, 255 .Append "НазначениеПлатежа5", adVarChar, 255 .Append "НазначениеПлатежа6", adVarChar, 255 .Append "СтатусСоставителя", adVarChar, 2 .Append "ПлательщикКПП", adVarChar, 9 .Append "ПолучательКПП", adVarChar, 9 .Append "ПоказательКБК", adVarChar, 20 .Append "ОКАТО", adVarChar, 11 .Append "ПоказательОснования", adVarChar, 2 .Append "ПоказательПериода", adVarChar, 10 .Append "ПоказательНомера", adVarChar, 255 .Append "ПоказательДаты", adDate, 8, adFldIsNullable .Append "ПоказательТипа", adVarChar, 2 .Append "Очередность", adVarChar, 2 .Append "СрокАкцепта", adInteger, 4 .Append "ВидАккредитива", adVarChar, 255 .Append "СрокПлатежа", adDate, 8, adFldIsNullable .Append "УсловиеОплаты1", adVarChar, 255 .Append "УсловиеОплаты2", adVarChar, 255 .Append "УсловиеОплаты3", adVarChar, 255 .Append "ПлатежПоПредст", adVarChar, 255 .Append "ДополнУсловия", adVarChar, 255 .Append "НомерСчетаПоставщика", adVarChar, 255 .Append "ДатаОтсылкиДок", adDate, 8, adFldIsNullable End With .Open End With End Sub
Ваше имя:
Пароль:
Сообщение:
Прикрепить:
Для вставки смайлов в текст щелкните по значку.