Импорт данных таблицы .xls в таблицу Аксесс и их обработка

@ankan · Регистрация: 28.09.2012

Студворк — интернет-сервис помощи студентам

Форумчане, доброго времени суток!
Прошу Вашей помощи.

Есть файлы.xls (перечень элементов) данные из которых нужно сгруппировать по "наименование" и просуммировать по "Кол" в каждой группе.(сейчас это приходится делать вручную)

Как я себе это представляю:
1.Пользователь ставит курсор на поле "Ссылка" формы1 , открывается проводник и в нем находится нужный файл (.xls) и нужный лист
2. нажимает на кнопку и производится импорт выбранного листа в аксесс
3. Нажимает на другую кнопку- выводится отчет в нужном виде ( с группировкой по "наименованию" и суммировано "Кол" в каждой группе.

Мне бы помочь по п. №1 и №2 - остальное сделаю сам.

mobile · 18.11.2017, 01:12

Считывать построчно и анализировать строки скучно и долго. С DOM-моделью XML я не настолько знаком, чтобы свободно анализировать. Подробно изучать пока не хочется. А попробовать с екселем показалось интересным. Считываем XML-файл в екселе и оттуда берем его запросом. В БД должен быть запрос с именем Temp. Его SQL заменяется в программе

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub readExcel_XML()
    Dim app As Object, wrk As Object
    Dim s, slk, fld, i, path, file, sheet, adr, mn, mx
    
    'Массив названий столбцов в ексель-файле
    fld = Array("FEEDERBASE/TAPEFEEDER/@TYPE", "FEEDERBASE/TAPEFEEDER/INSTALL/@BASE", _
    "FEEDERBASE/TAPEFEEDER/INSTALL/@SLOT", "FEEDERBASE/TAPEFEEDER/TAPE/@PARTNAME")
    
    path = "c:\Temp"      'Путь к XML-файлу
    file = "proba 1.xml"  'Имя  XML-файла
    sheet = Left(file, Len(file) - 4)  'Имя листа.
    
    Set app = CreateObject("excel.application")
    Set wrk = app.workbooks.Open(path & "\" & file)
    app.Rows("1:2").Select
    s = "select * from "
    mn = "zzz": mx = ""
    For i = 0 To 3
        'Ищем заголовки столбцов
        app.Selection.Find(What:=fld(i), After:=app.ActiveCell, _
            LookIn:=-4123, LookAt:=2, SearchOrder:=1, _
            SearchDirection:=1, MatchCase:=False, SearchFormat:=False).Activate
        adr = app.ActiveCell.address 'Адрес столбца
        adr = Mid(Left(adr, InStr(2, adr, "$") - 1), 2)
        If adr < mn Then mn = adr
        If adr > mx Then mx = adr
    Next
    'Начальное формирование строки SQL
    s = s & "[" & sheet & "$" & mn & "3:" & mx & "2000] "
    
    On Error Resume Next
    'Удалить временный файл екселя
    Kill CurrentProject.path & "\temp.xlsx"
    On Error GoTo 0
    
    'Сохранить файл для запроса к нему
    wrk.SaveAs FileName:=CurrentProject.path & "\temp.xlsx"
    wrk.Close
    app.Quit
    
    'Завершение SQL-выражения
    s = Left(s, Len(s) - 1)
    s = s & " in '" & CurrentProject.path & "\temp.xlsx" & "'[Excel 12.0;hdr=no;]"
    s = "select F1 as [TAPEFEEDER TYPE], F2 as [BASE], " _
    & "F4 as [INSTALL SLOT], F8 as [TAPE PARTNAME] from (" & s & ") where F1 & '' <> ''"
    
    'Присвоение SQL запросу Temp и вызов запроса
    CurrentDb.QueryDefs("Temp").sql = s
    DoCmd.OpenQuery "Temp"
End Sub

@ankan · 19.11.2017, 20:02 **[ТС]**

mobile, ругается. Возможно, нужно иподключить какую-то библиотеку?

@ankan · 21.11.2017, 15:10 **[ТС]**

mobile, Если на компьютере установлен Иксель 2007- то работает, если иксель 2003 или Open Office - не работает. Возможно ли сделать универсальный код под Иксель 2003 (.xls), Иксель 2007(xlsx) и Open Office (.ods) ?

mobile · 21.11.2017, 15:57

Процедура поиска в Excel 2010 записана с помощью средства Excel "запись макроса". При переносе в Access имена констант заменены на числа и добавлены паренты (app) к объектам. Как надо писать в других версиях екселя или опенофиса не знаю. Записывайте макрос, переносите в Access

@ankan · 24.11.2017, 13:00 **[ТС]**

mobile, тестировал Ваш код , выяснил следующее:

Если установлен Windiws 7 профессиональная + Excel 2007 +Access 2007- код работает:
Если установлен Windiws 10 + Excel 2010 + Аксесс runtime 2003 (без Аксесс 2010) - код не работает (ошибка выполнения. Приложение будет закрыто);
Если установлен Windiws 10 + Excel 2007 + Аксесс 2007 - код работает ;
Если установлен Windiws XP + Excel 2010 + Аксесс runtime 2003(без Аксесс 2010) - код не работает (ошибка выполнения. Приложение будет закрыто)

Интерфейс у меня на Аксесс 2003, таблицы- MySQL
Вывод - код работает только при наличии установленного Аксесс.Если установлен только Аксесс runtime 2003- код не работает.
Возможно мои выводы ошибочны. Прошу Вас, по возможности, прокоментировать мои размышления, проверить. Если получится - поправить код.

@Jamaica · 24.11.2017, 13:41

Насколько помню, CreateObject в Runtime не работает.
Надо юзать GetObject.

@ankan · 24.11.2017, 14:40 **[ТС]**

Jamaica, нашел на форуме похожую тему http://www.sql.ru/forum/102374... aetsya-kod
. Утверждают, что CreateObject в аксесс runtime не работает.

@Eugene-LS · 24.11.2017, 14:48

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

Записывайте макрос, переносите в Access

И да поможет вам список констант!

(смотрите вложение)

@ankan · 24.11.2017, 15:04 **[ТС]**

Eugene-LS, файл не открывается. Можно ли пересохранить в другом формате?

@Eugene-LS · 24.11.2017, 15:10

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

файл не открывается. Можно ли пересохранить в другом формате?

Странно ... Скачал (отсюда-же) - всё открывается.

Ладно - не вопрос! Вот в RAR

@Eugene-LS · 24.11.2017, 15:11

А RAR-чик то жмёт всё-же лучше чем ZIP ...

@ankan · 24.11.2017, 15:21 **[ТС]**

Eugene-LS, не открывался файл ".bas". Изменил расширение на ".xls"- открылся.

@Eugene-LS · 24.11.2017, 16:19

ankan, ну тогда уж так:

@ankan · 27.11.2017, 14:28 **[ТС]**

Форумчане, приветствую!
Продолжаю пробовать разные варианты импорта файла ".xml" в Аксесс
Нашел на https://support.microsoft.com/... -in-access
вариант, тестирую его. Хочется что-бы можно было импортировать файл ".xml" в Аксесс используя только Аксесс Runtime 2003/
Описание работы.
1. Копируем папку вложения целиком в корень диска "C":
2. Открываем БД "ImportADOXML.mdb"
3. запускаем модуль "basCreateADOXML"- создаем файл "ado_customersUK.xml"
4. запускаем модуль "ADOXMLToAccess"- должны импортировать файл "ado_customersUK.xml" в "ImportADOXML.mdb"
но у меня это не срабатывает- см. скрины
доп. пояснения: файл "ADOXMLToAccess.xsl"- служит для создание преобразования XSL

Прошу помочь разобраться с данным примером, изменить его для импорта моих файлов ".xml" в приложение Аксесс, запускаемое Аксесс runtime.

@ankan · 30.11.2017, 14:31 **[ТС]**

mobile, Следую Вашему совету:

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

Записывайте макрос, переносите в Access

создал макрос по сохранению в иксель 2003

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
'Sub Макрос1()
' Макрос1 Макрос
' Макрос записан 30.11.2017 (ALFA)
'
' Сочетание клавиш: Ctrl+a
'
    ChDir "C:\Users\ALFA\Desktop"
    ActiveWorkbook.SaveAs Filename:="C:\Users\ALFA\Desktop\11111.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Перенес его в аксесс

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Sub readExcel_XML_2003()
    Dim app As Object, wrk As Object
    Dim s, slk, fld, i, path, file, sheet, adr, mn, mx
    
    'Массив названий столбцов в ексель-файле
    fld = Array("FEEDERBASE/TAPEFEEDER/@TYPE", "FEEDERBASE/TAPEFEEDER/INSTALL/@BASE", _
    "FEEDERBASE/TAPEFEEDER/INSTALL/@SLOT", "FEEDERBASE/TAPEFEEDER/TAPE/@PARTNAME")
    
    path = "c:\Temp"      'Путь к XML-файлу
    file = "1.xml"  'Имя  XML-файла
    sheet = Left(file, Len(file) - 4)  'Имя листа.
    
    Set app = CreateObject("excel.application")
    Set wrk = app.workbooks.Open(path & "\" & file)
    app.Rows("1:2").Select
    s = "select * from "
    mn = "zzz": mx = ""
    For i = 0 To 3
        'Ищем заголовки столбцов
        app.Selection.Find(What:=fld(i), After:=app.ActiveCell, _
            LookIn:=-4123, LookAt:=2, SearchOrder:=1, _
            SearchDirection:=1, MatchCase:=False, SearchFormat:=False).Activate
        adr = app.ActiveCell.Address 'Адрес столбца
        adr = Mid(Left(adr, InStr(2, adr, "$") - 1), 2)
        If adr < mn Then mn = adr
        If adr > mx Then mx = adr
    Next
    'Начальное формирование строки SQL
    s = s & "[" & sheet & "$" & mn & "3:" & mx & "2000] "
    
    On Error Resume Next
    'Удалить временный файл екселя
    Kill CurrentProject.path & "\temp.xls"
    On Error GoTo 0
    
    'Сохранить файл для запроса к нему
    'wrk.SaveAs FileName:=CurrentProject.path & "\temp.xls"
    
    wrk.SaveAs FileName:=CurrentProject.path & "\temp.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        
        
    wrk.Close
    app.Quit
    
    'Завершение SQL-выражения
    s = Left(s, Len(s) - 1)
    s = s & " in '" & CurrentProject.path & "\temp.xls" & "'[Excel 12.0;hdr=no;]"
    s = "select F1 as [TAPEFEEDER TYPE], F2 as [BASE], " _
    & "F4 as [INSTALL SLOT], F8 as [TAPE PARTNAME] from (" & s & ") where F1 & '' <> ''"
    
    'Присвоение SQL запросу Temp и вызов запроса
    CurrentDb.QueryDefs("Temp").SQL = s
    DoCmd.OpenQuery "Temp"
End Sub

Не работает в аксессе, зависает намертво. Выход только через диспетчер задач.

Модернизированный мной под использование иксель 2003 Ваш код каждый раз хочет запустить Иксель 2007 ( Иксель 2007 у меня также установлена , но не активна.)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub readExcel_XML_2003()
    Dim app As Object, wrk As Object
    Dim s, slk, fld, i, path, file, sheet, adr, mn, mx
    
    'Массив названий столбцов в ексель-файле
    fld = Array("FEEDERBASE/TAPEFEEDER/@TYPE", "FEEDERBASE/TAPEFEEDER/INSTALL/@BASE", _
    "FEEDERBASE/TAPEFEEDER/INSTALL/@SLOT", "FEEDERBASE/TAPEFEEDER/TAPE/@PARTNAME")
    
    path = "c:\Temp"      'Путь к XML-файлу
    file = "1.xml"  'Имя  XML-файла
    sheet = Left(file, Len(file) - 4)  'Имя листа.
    
    Set app = CreateObject("excel.application")
    Set wrk = app.workbooks.Open(path & "\" & file)
    app.Rows("1:2").Select
    s = "select * from "
    mn = "zzz": mx = ""
    For i = 0 To 3
        'Ищем заголовки столбцов
        app.Selection.Find(What:=fld(i), After:=app.ActiveCell, _
            LookIn:=-4123, LookAt:=2, SearchOrder:=1, _
            SearchDirection:=1, MatchCase:=False, SearchFormat:=False).Activate
        adr = app.ActiveCell.Address 'Адрес столбца
        adr = Mid(Left(adr, InStr(2, adr, "$") - 1), 2)
        If adr < mn Then mn = adr
        If adr > mx Then mx = adr
    Next
    'Начальное формирование строки SQL
    s = s & "[" & sheet & "$" & mn & "3:" & mx & "2000] "
    
    On Error Resume Next
    'Удалить временный файл екселя
    Kill CurrentProject.path & "\temp.xls"
    On Error GoTo 0
    
    'Сохранить файл для запроса к нему
    wrk.SaveAs FileName:=CurrentProject.path & "\temp.xls"
    wrk.Close
    app.Quit
    
    'Завершение SQL-выражения
    s = Left(s, Len(s) - 1)
    s = s & " in '" & CurrentProject.path & "\temp.xls" & "'[Excel 12.0;hdr=no;]"
    s = "select F1 as [TAPEFEEDER TYPE], F2 as [BASE], " _
    & "F4 as [INSTALL SLOT], F8 as [TAPE PARTNAME] from (" & s & ") where F1 & '' <> ''"
    
    'Присвоение SQL запросу Temp и вызов запроса
    CurrentDb.QueryDefs("Temp").SQL = s
    DoCmd.OpenQuery "Temp"
End Sub

т.е. тоже не подходит .
сейчас обдумываю какие еще варианты решения могут быть. Возможно я просто не так скомбинировал код под использование иксель 2003. Посмотрите, пожалуйста, возможно решение по использованию кода для иксель 2003 уже есть , но я его еще не рассмотрел.

@ankan · 09.02.2018, 13:41 **[ТС]**

mobile, соорудил из Ваших разработок вроде работающую процедуру, но она работает только если жестко закреплена директория и имя файла. Если нам нужна другая директория или другое имя файла с расширением ".xml"-то не смотря на мои доработки (указывал путь из формы) упорно не работает.
Может подскажете, где ошибка?
Для отработки можно поместить файл "2.xml" в несколько разных директорий и попытаться импортировать.
Имя файла тоже будет различаться.

- думаю, различные процедуры в форме frmProv_Yctan_Komp_Na_Yctan
модули:
modProverka_Yctan_Komp_Na_Yctan
modReadExcel_XML

в чем-то дублируют друг друга.Можно как-то оптимизировать коды?

@alvk · 14.02.2018, 10:17

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

имя файла с расширением ".xml"-то не смотря на мои доработки (указывал путь из формы) упорно не работает.

Тут бы я порекомендовал просто сначала сохранить этот файл как xlsx, а потом уже работать с сохранённым файлом. Это же импорт в Акцесс, нам главное данные получить?

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

но она работает только если жестко закреплена директория и имя файла.

возможно вы кавычки не выставили по бокам у пути к файлу

Новые блоги и статьи Все статьи Все блоги /
История и социология Терры на примере борьбы микориз за пространство. 1. Глоссарий терры. anaschu 21.07.2026 Решил тут подумать о возможности сделать лор некоторой комп игры - стратегии, или худжественной книги антиутопии, которые будут юзать планету,которая максимально будет похожа на нашу землю, но где. . .	Теория всего 6. Судьба неотвратима? anaschu 21.07.2026 Математическое доказательство Судьбы: Точка бифуркации в едином тензорном ядре Модели ВсегоСвежее обновление питоновского ядра «Soil Chemistry 2. 0» дало нам неопровержимое математическое. . .	Теория всего 5. ядро Теории Всего: Математический изоморфизм репликаторов и иллюзия свободы воли anaschu 21.07.2026 Единое ядро Теории Всего: Математический изоморфизм репликаторов и иллюзия свободы воли Главная задача «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы» (аттракторов. . .	сукцессия 37. Внедрил дипсик в свой оркестр из ИИ. У него закончилось пространство чата, потому опубликую выводы из его работы здесь anaschu 21.07.2026 ==================================================================== КОНТЕКСТ: Моделирование микоризной сукцессии (AM → ECM) ==================================================================== . . .
сукцессия 36. Делаю прогоны модели около порога бифуркации (превращения эндо микоризы в экто микоризу) anaschu 21.07.2026 СУКЦЕССИЯ МИКОРИЗ: КАК МАТЕМАТИКА ОБЪЯСНЯЕТ ПОДЗЕМНУЮ ВОЙНУ Мы привыкли думать, что лес — это деревья. А грибы — это то, что мы собираем в корзинку осенью. Но если заглянуть под землю, окажется,. . .	ИИ и человечность kumehtar 21.07.2026 Забавно, что общаясь с ИИ, я замечаю, насколько он высказывается умно, и насколько верит в людей. Он умеет прощать. Он знает как отвечать не обесценивая опыт других людей, даже если сам не верит. Он. . .	Нейтральные знания ..., ... чистая наука. Пока что-то проходит модерацию на Хабре, стоит развить мысль ... Hrethgir 20.07.2026 К таким радикальным взглядам я конечно в той публикации не приходил, но чтобы скоротать вечер, решил углубиться немного. 1. Почему показания термометра заряжены целью? Цель заложена в самом. . .	Установка нескольких штампов электронной подписи в строго определенных местах файла docx ВладимирСамохин 19.07.2026 (В!) Работа с Электронной подписью - это неотъемлемая часть современного документооборота. Но что делать, если нужно поставить несколько штампов электронной подписи в строго определенных местах. . .

@ankan 46 / 31 / 1 Регистрация: 28.09.2012 Сообщений: 991
	19.11.2017, 20:02 [ТС]
	mobile, ругается. Возможно, нужно иподключить какую-то библиотеку? Миниатюры 0

@ankan 46 / 31 / 1 Регистрация: 28.09.2012 Сообщений: 991
	21.11.2017, 15:10 [ТС]
	mobile, Если на компьютере установлен Иксель 2007- то работает, если иксель 2003 или Open Office - не работает. Возможно ли сделать универсальный код под Иксель 2003 (.xls), Иксель 2007(xlsx) и Open Office (.ods) ? 0

mobile 26828 / 14509 / 3192 Регистрация: 28.04.2012 Сообщений: 15,782
	21.11.2017, 15:57
	Процедура поиска в Excel 2010 записана с помощью средства Excel "запись макроса". При переносе в Access имена констант заменены на числа и добавлены паренты (app) к объектам. Как надо писать в других версиях екселя или опенофиса не знаю. Записывайте макрос, переносите в Access 0

@ankan 46 / 31 / 1 Регистрация: 28.09.2012 Сообщений: 991
	24.11.2017, 13:00 [ТС]
	mobile, тестировал Ваш код , выяснил следующее: Если установлен Windiws 7 профессиональная + Excel 2007 +Access 2007- код работает: Если установлен Windiws 10 + Excel 2010 + Аксесс runtime 2003 (без Аксесс 2010) - код не работает (ошибка выполнения. Приложение будет закрыто); Если установлен Windiws 10 + Excel 2007 + Аксесс 2007 - код работает ; Если установлен Windiws XP + Excel 2010 + Аксесс runtime 2003(без Аксесс 2010) - код не работает (ошибка выполнения. Приложение будет закрыто) Интерфейс у меня на Аксесс 2003, таблицы- MySQL Вывод - код работает только при наличии установленного Аксесс.Если установлен только Аксесс runtime 2003- код не работает. Возможно мои выводы ошибочны. Прошу Вас, по возможности, прокоментировать мои размышления, проверить. Если получится - поправить код. 0

@Jamaica 1333 / 551 / 112 Регистрация: 29.03.2016 Сообщений: 1,355
	24.11.2017, 13:41
	Насколько помню, CreateObject в Runtime не работает. Надо юзать GetObject. 1

@ankan 46 / 31 / 1 Регистрация: 28.09.2012 Сообщений: 991
	24.11.2017, 14:40 [ТС]
	Jamaica, нашел на форуме похожую тему http://www.sql.ru/forum/102374... aetsya-kod . Утверждают, что CreateObject в аксесс runtime не работает. 0

@ankan 46 / 31 / 1 Регистрация: 28.09.2012 Сообщений: 991
	24.11.2017, 15:04 [ТС]
	Eugene-LS, файл не открывается. Можно ли пересохранить в другом формате? 0

@Eugene-LS 13241 / 5921 / 1524 Регистрация: 05.10.2016 Сообщений: 16,584
	24.11.2017, 15:11
	А RAR-чик то жмёт всё-же лучше чем ZIP ... 0