Rambler's Top100
Форум: MS ACCESSVBVBA MS OfficeMS SQL server
Новые сообщения: 0000

Форум: MS ACCESS

Вопросы связанные с MS ACCESS

Обновить визитку
Участники «Online»
Все участники

 
 

Доброго времени суток, Посетитель!

вид форума:
Линейный форум Структурный форум

тема: Импорт выписки из банка в тбл (формат 1cclientbankexchange)
 
 автор: amba-l   (16.03.2015 в 15:41)   личное сообщение
7 Кб.
 
 

Добрый день, столкнулся с необходимостью обработать выписку банка и упихнуть её в XLS.
Если кто-то решал уже эту задачу средствами Accessa ли, VBA ли буду признателен за возможность списать, пиво при встрече, либо денежные знаки по перечислению в качестве благодарности- с меня.
образец файла выписки в аттачменте, засада в том что количество полей в каждой секции непостоянно,определяется содержанием документа, из хорошего-структура формализована и описана.
1cclientbankexchange описание формата
http://v8.1c.ru/edi/edi_stnd/100/101.htm

  Ответить  
 
 автор: Lukas   (16.03.2015 в 21:01)   личное сообщение
64 Кб.
 
 

Ты не думай, мы не отмазываемся.
Мы уже кропаем в поте лица!
:)
Вопросы:
1. Каждый импорт должен быть в свой файл/лист,
или все импорты должны подгружаться в один,
заранее определенный, файл/лист?
2. Общие сведения (шапка файла до документов) пихать в таблицу или отдельно, типа как здесь =>?

  Ответить  
 
 автор: amba-l   (16.03.2015 в 22:30)   личное сообщение
 
 

как вариант,
делаем папку кудой складываем txt файл

судя по примеру речь идет о vba в excel
соответственно кнопочкой запускаем процедуру которая заполняет тбл по содержимому файла, дальше с табличными данными разберусь
шапка не нужна

  Ответить  
 
 автор: Lukas   (16.03.2015 в 22:36)   личное сообщение
 
 

Черновик (колонки дат и денег нужно форматировать),
можно выбирать несколько файлов txt сразу, весь импорт на новый лист новой книги:

ps. почикал

  Ответить  
 
 автор: Lukas   (16.03.2015 в 22:38)   личное сообщение
 
 

Поздно заметил, что шапка не нужна.
Ну, лишнее кастрировать.
:)

  Ответить  
 
 автор: Lukas   (16.03.2015 в 23:04)   личное сообщение
 
 

Без шапки, с небольшим форматированием:

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

  Ответить  
 
 автор: amba-l   (16.03.2015 в 23:42)   личное сообщение
 
 

Спасибо, но продолжу наглеть...
я уже лет 10-12 не брал шашку в руке, т.е. не нажимал alt+f11 в excel
соответственно сразу деббагер ругается на Private rst As ADODB.Recordset
что и где подключить? (кроме мозга естественно:-))

  Ответить  
 
 автор: Lukas   (16.03.2015 в 23:48)   личное сообщение
16 Кб.
 
 

Прости, забыл предупредить.
XLS файл в архиве =>

  Ответить  
 
 автор: Lukas   (16.03.2015 в 23:49)   личное сообщение
39 Кб.
 
 

Библиотека ADO нужна:

  Ответить  
 
 автор: alxrmnk   (01.07.2015 в 13:16)   личное сообщение
13 Кб.
 
 

У меня не работает :(

Выдает ошибку в строке:
rst.Fields(row(0)) = row(1)


Выписка немного иного вида, но тоже в формате 1С.
Она выгружается из банк клиента.

В чем может быть причина?

Файл приложил.

  Ответить  
 
 автор: alxrmnk   (01.07.2015 в 15:07)   личное сообщение
16 Кб.
 
 

Скриншот

  Ответить  
 
 автор: Lukas   (01.07.2015 в 21:13)   личное сообщение
50 Кб.
 
 

В выписке:
1. не заполнены некоторые поля с датой
2. имеются счета о 25 знаках.

Поправил для вашей выписки =>

  Ответить  
 
 автор: alxrmnk   (02.07.2015 в 11:20)   личное сообщение
17 Кб.
 
 

Короткую читает здорово! :-)
Импортирую большую выписку и снова ошибка в той же строке :-(

rst.Fields(row(0)) = IIf(row(1) = vbNullString, Null, row(1))


У меня в выписке 13 150 строк. Это же не должно мешать?
С количеством знаков и пустыми значениями проблема, наверное?

Я могу скинуть вам на почту выписку?

Скриншот >>>

  Ответить  
 
 автор: alxrmnk   (02.07.2015 в 11:27)   личное сообщение
 
 

Lukas, cкинул в личном сообщении

  Ответить  
 
 автор: Lukas   (02.07.2015 в 21:56)   личное сообщение
17 Кб.
 
 

ПоказательДаты=0

Попробуем еще поправить =>

  Ответить  
 
 автор: alxrmnk   (03.07.2015 в 18:28)   личное сообщение
 
 

Спасибо космическое !!!

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

Если будут еще задачи, могу обращаться на комм. основе?

  Ответить  
 
 автор: maloy20051   (12.10.2016 в 12:32)   личное сообщение
23 Кб.
 
 

Добрый день ! После обновления БК пытаюсь загрузить файлики Run-time error '-2147217887 (80040e21) в degug ругань на эту строку rst.Fields(row(0)) = row(1) файлик обрабатываемый если надо могу в ЛС отправить

  Ответить  
 
 автор: amba-l   (16.03.2015 в 23:53)   личное сообщение
 
 

УРАААААА, ЗАРАБОТАЛОООООО!!!
спасибо громаднющее,

  Ответить  
 
 автор: Lukas   (17.03.2015 в 00:07)   личное сообщение
 
 

Не за что.

  Ответить  
 
 автор: Lukas   (17.03.2015 в 00:21)   личное сообщение
15 Кб.
 
 

Вариант3:
при первом импорте создает лист в этой-же книге для данных выписок и добавляет в него данные,
при последующем импорте только добавляет данные на уже имеющийся лист этой книги.
+ кнопочка меню для запуска импорта.

  Ответить  
 
 автор: maloy20051   (12.10.2016 в 12:33)   личное сообщение
 
 

а где кнопка загрузить ? в смысле я в макросы захожу а там ничего ... :(

  Ответить  
HiProg.com - Технологии программирования
Rambler's Top100 TopList