Юрій Марків
Академік
Повідомлень: 795
Зареєстрований: 10-12-2003
Місто: Lviv
Нема на форумі
Настрій: :-)
|
|
VBA for Access
Привіт, люди!
Така задачка.
Імпортую один екселівський файл в Access за допомогою коду VBA
| Цитата: | | DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "TableName", "C:\File.xls" |
Тим часом знадобилося імпортувати в окремі таблиці кілька сотень таких файлів,
імена файлів вказані в таблиці Access table3, таблиці повинні називатися так, як файли.
Хтось підкаже, як це зробити?
|
|
|
Юрій Марків
Академік
Повідомлень: 795
Зареєстрований: 10-12-2003
Місто: Lviv
Нема на форумі
Настрій: :-)
|
|
Я тут по ходу п'єси вже дещо накалякав для імпорту купи файлів у таблиці Access:
| Цитата: | Sub test()
Dim rstCurr As DAO.Recordset
Dim dbsCurr As Database
Dim MyPath As String
Dim MyFile As String
Dim ShortFile As String
MyPath = "C:\Marchello\"
Set dbsCurr = Access.CurrentDb
Set rstCurr = dbsCurr.OpenRecordset("Table1", dbOpenDynaset)
MyFile = Dir(MyPath)
Do While MyFile <> ""
rstCurr.AddNew
rstCurr.Fields("1").Value = Time$
rstCurr.Fields("2").Value = Date$
rstCurr.Fields("3").Value = MyPath
rstCurr.Fields("4").Value = MyFile
rstCurr.Update
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97,
MyFile, MyPath & MyFile
MyFile = Dir
Loop |
Тепер ще залишилася теж нетривіальна частина роботи.
Потрібно пройти кожну стрічку таблиць Access iз іменами r* .
Структура даних таблиць (працюємо лише з стовпчиком "F2") :
створення
зміна
вилучення
Принаймні один з блоків мусить бути непорожнім (або й кожен), наприклад:
таблиця "r071203_xls"
створення
9129001
зміна
6026008
вилучення
Таким чином, потреба полягає в тому, щоб построково проаналізувати кожну таблицю
"r*", знайти семизначні цифрові коди в кожному блоці і створити нову таблицю:
поле1: назва таблиці "r*"
поле2: 7-значний числовий код
поле3: створення, зміна чи вилучення
Я на програміста ніколи не вчився...
Можливо, хтось щось підкаже?
|
|
|
Юрій Марків
Академік
Повідомлень: 795
Зареєстрований: 10-12-2003
Місто: Lviv
Нема на форумі
Настрій: :-)
|
|
Поки ніхто не відповідає, пишу сюди, що наразі в мене вийшло...
Ось приклад таблиці Access, з якою я працюю (прінтскрін) :
http://marchello.ccx-grads.org/example.jpg
На виході потрібно отримати таблицю з полями:
1) назва таблиці
2) 7-значний код
3) дія (create, change або delete)
Ось мій код для аналізу таблиць:
| Цитата: | Sub test()
Dim db As DAO.Database, tdf As DAO.TableDef
Dim strAction As String
Dim rstIn As DAO.Recordset, rstOut As DAO.Recordset
' Point to this database
Set db = CurrentDb
' Open the output recordset
Set rstOut = db.OpenRecordset("tblOutput", _
dbOpenDynaset, dbAppendOnly)
' Loop through all tabledefs
For Each tdf In db.TableDefs
' Look for a table name starting with "r"
'If tdf.Name Like "r*" Then
If Left(tdf.Name, 1) = "r" Then
' Found one - open it
Set rstIn = db.OpenRecordset("SELECT F2 " & _
"FROM [" & tdf.Name & "] " & _
"WHERE Len(F2 & """") = 0")
' Process all the records
Do Until rstIn.EOF
' See if keyword
If (rstIn!F2 = "Create") Or (rstIn!F2 = "Change") _
Or (rstIn!F2 = "Delete") Then
' Just save the action
strAction = rstIn!F2
Else
' Make sure we have a good action
If Len(strAction) > 0 Then
' Write an output record
rstOut.AddNew
rstOut!Field1 = tdf.Name
rstOut!Field2 = rstIn!F2
rstOut!Field3 = strAction
rstOut.Update
End If
End If
' Get the next record
rstIn.MoveNext
Loop
' Close the input
rstIn.Close
End If
' Get the next table
Next tdf
' Clean up
rstOut.Close
Set rstIn = Nothing
Set rstOut = Nothing
Set tdf = Nothing
Set db = Nothing
End Sub |
Наразі не спрацьовує. Хтось може підказати, чому?
|
|
|
Aндpiй
Дійсний член
Повідомлень: 128
Зареєстрований: 30-4-2003
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
Не спрацьовує тому, що В SQL-запиті
Set rstIn = db.OpenRecordset("SELECT F2 " & _
"FROM [" & tdf.Name & "] " & _
"WHERE Len(F2 & """") = 0")
стоїть умова відбирати лише порожні значення із вхідної таблиці, а нам треба -
лише непорожні, тобто
Set rstIn = db.OpenRecordset("SELECT F2 " & _
"FROM [" & tdf.Name & "] " & _
"WHERE Len(F2 & """") > 0")
P.S. Можете надалі звертатись до мене стосовно VBA
|
|
|
Юрій Марків
Академік
Повідомлень: 795
Зареєстрований: 10-12-2003
Місто: Lviv
Нема на форумі
Настрій: :-)
|
|
| Цитата: | Оригінальне повідомлення від Aндpiй
стоїть умова відбирати лише порожні значення із вхідної таблиці, а нам треба -
лише непорожні, тобто
Set rstIn = db.OpenRecordset("SELECT F2 " & _
"FROM [" & tdf.Name & "] " & _
"WHERE Len(F2 & """") > 0")
|
Дякую, Андрію!  ))))
Нарешті від вчорашнього ранку помиюся, переодягнуся, поїм і взагалі вийду на
вулицю! 
|
|
|
Павло Жежнич
Модератор
Повідомлень: 1139
Зареєстрований: 24-11-2002
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
Питання/пропозиції:
1) Чи структура файлів однакова? Якщо так, то чи не краще створити таблицю-лінк file_xls
на File.xls, а при імпорті потрібного файлу робити його копію на "C:\File.xls". Тоді весь
імпорт буде виглядати так:
SQLtext = " INSERT INTO TableName (<поля> SELECT <поля> FROM
file_xls; "
CurrentDB.Execute SQLtext
2) Вибір порожніх/непорожніх краще здійснювати умовою
" WHERE F2 IS NULL " / " WHERE F2 IS NOT NULL "
3) Взагалі я б рекомендував для вставки/видалення/редагування (всюди де можна)
використовувати SQL-запити, а не рекордсети.
|
|
|
Aндpiй
Дійсний член
Повідомлень: 128
Зареєстрований: 30-4-2003
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
Павло Жежнич,
пожалійте людину - він же сказав, що на програміста ніколи не вчився
|
|
|
Юрій Марків
Академік
Повідомлень: 795
Зареєстрований: 10-12-2003
Місто: Lviv
Нема на форумі
Настрій: :-)
|
|
| Цитата: | Оригінальне повідомлення від Aндpiй
Павло Жежнич,
пожалійте людину - він же сказав, що на програміста ніколи не вчився
|
+1
Та все одно дуже дякую за участь, Павло!
|
|
|
Павло Жежнич
Модератор
Повідомлень: 1139
Зареєстрований: 24-11-2002
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
| Цитата: | Оригінальне повідомлення від Aндpiй
Павло Жежнич,
пожалійте людину - він же сказав, що на програміста ніколи не вчився |
Якщо людина на програміста не вчилася, то вона повинна бути зацікавлена писати як
найменше програмного коду! Я власне це
рекомендую.
А написання SQL-запитів - це не програмування - один "правильний" запит може замінити
десятки стрічок програмного коду.
|
|
|
Aндpiй
Дійсний член
Повідомлень: 128
Зареєстрований: 30-4-2003
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
| Цитата: |
Якщо людина на програміста не вчилася, то вона повинна бути зацікавлена писати як
найменше програмного коду! Я власне це рекомендую.
|
Я думаю, що п.Юрію, хоча він робить перші кроки, вдалось написати власноруч менше
коду, ніж найбільшому асу в програмуванні 
Пане Павле - цікаво було б побачити ваш варіант рішення цієї задачі за допомогою SQL
без використання VBA
|
|
|
Юрій Марків
Академік
Повідомлень: 795
Зареєстрований: 10-12-2003
Місто: Lviv
Нема на форумі
Настрій: :-)
|
|
Ще цікавить, як витягнути кожну назву листа екселівського файлу і додати в
таблицю tblOutput
| Цитата: | | rstOut!Field4 = ... |
|
|
|
Aндpiй
Дійсний член
Повідомлень: 128
Зареєстрований: 30-4-2003
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
П.Юрію, доведеться використовувати інший підхід, який до-речі, дозволяє
відмовитися від TransferSpreadsheet, бо вже можна безпосередньо керувати всіма об'єктами
Excel
Раніше наведена програма матиме вигляд (додані стрічки - з коментарями)
| Цитата: |
Sub test()
Dim rstCurr As DAO.Recordset
Dim dbsCurr As Database
Dim MyPath As String
Dim MyFile As String
Dim ShortFile As String
Dim myOlApp As Object 'об'єкт Excel
Dim MyWo As Excel.Workbook 'книга
Dim mysheet As Excel.Worksheet 'сторінка
Set myOlApp = CreateObject("excel.Application") 'встановлюємо зв'язок з Excel
MyPath = "C:\Marchello\"
Set dbsCurr = Access.CurrentDb
Set rstCurr = dbsCurr.OpenRecordset("Table1", dbOpenDynaset)
MyFile = Dir(MyPath)
Do While MyFile <> ""
Set MyWo = myOlApp.Workbooks.Open(MyPath & MyFile) 'відкриваємо документ
For Each mysheet In MyWo.Worksheets 'переглядаємо всі сторінки
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "a", MyPath & MyFile, , mysheet.Name & "$" ' тут вказуємо
додатковий параметр - яку сторінку
rstCurr.AddNew
rstCurr.Fields("1").Value = Time$
rstCurr.Fields("2").Value = Date$
rstCurr.Fields("3").Value = MyPath
rstCurr.Fields("4").Value = MyFile
rstCurr.Fields("5").Value = mysheet.Name 'це назва сторінки (додати поле в таблицю)
rstCurr.Update
Next mysheet 'беремо наступну сторінку
MyWo.Close 'звільняємо
MyFile = Dir
Loop
End Sub
|
В програмі додати в меню Сервис-ссылки: Microsoft Excel nn Object Library
|
|
|
Павло Жежнич
Модератор
Повідомлень: 1139
Зареєстрований: 24-11-2002
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
| Цитата: | Оригінальне повідомлення від Aндpiй
Пане Павле - цікаво було б побачити ваш варіант рішення цієї задачі за допомогою SQL
без використання VBA |
Питання не стоїть, що треба відмовлятися від VBA. Просто у частині коду, де можна, я
стараюся використовувати SQL-код, а не VBA-код. Стилістично це виглядає приблизно
так:
| Цитата: |
Sub test()
Dim SQLtext As String
Dim dbsCurr As Database
Dim MyPath As String
Dim MyFile As String
Dim ShortFile As String
Dim myOlApp As Object 'об'єкт Excel
Dim MyWo As Excel.Workbook 'книга
Dim mysheet As Excel.Worksheet 'сторінка
Set myOlApp = CreateObject("excel.Application") 'встановлюємо зв'язок з Excel
MyPath = "C:\Marchello\"
Set dbsCurr = Access.CurrentDb
Set rstCurr = dbsCurr.OpenRecordset("Table1", dbOpenDynaset)
MyFile = Dir(MyPath)
Do While MyFile <> ""
Set MyWo = myOlApp.Workbooks.Open(MyPath & MyFile) 'відкриваємо документ
For Each mysheet In MyWo.Worksheets 'переглядаємо всі сторінки
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "a", MyPath & MyFile, , mysheet.Name & "$" ' тут вказуємо
додатковий параметр - яку сторінку
'-----------
SQLtext = " INSERT INTO Table1 (F1, F2, F3, F4, F5) " _
& " VALUES ('" & Time$ & "', '" & Date$ & "', '" & MyPath & "', '" & MyFile & "', '" & mysheet.Name &
"');"
CurrentDB.Execute SQLtext
'-----------
Next mysheet 'беремо наступну сторінку
MyWo.Close 'звільняємо
MyFile = Dir
Loop
End Sub
|
Я не випадково питав, чи структура xls-файлів завжди однакова (наприклад, якщо дані
записуються лише на першому листку з однаковою структурою), то взагалі можна
обійтися без імпорту xls-файлу в тимчасову таблицю.
|
|
|
Aндpiй
Дійсний член
Повідомлень: 128
Зареєстрований: 30-4-2003
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
Використовуючи автоматизацію без імпорту xls-файлу в тимчасову таблицю можна
обійтись в будь-якому випадку
|
|
|
Павло Жежнич
Модератор
Повідомлень: 1139
Зареєстрований: 24-11-2002
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
Спочатку треба зробити копію одного з файлів у import.xls, далі - створити лінк на
перший листок цього файлу через меню "Файл/Зовнішні дані/Зв'язок з таблицями".
Створений лінк назвати "import_xls". Тоді код може виглядати приблизно так:
| Цитата: |
Sub test()
Dim SQLtext As String, rs AS DAO.Recordset
Dim MyPath As String
MyPath = "C:\Marchello\"
Dim MyFile As String
MyFile = Dir(MyPath)
While MyFile <> ""
Kill MyPath & "import.xls"
FileCopy MyPath & MyFile, MyPath & "import.xls"
SQLtext = " SELECT F1, F2, F3, F4, F5 FROM import_xls "
Set rs = CurrentDB.OpenRecorset(SQLtext)
While Not rs.EOF
'-----------
'Тут треба аналізувати вміст rs!F1,...,rs!F5
'і вставляти у потрібну таблицю
'(приклад вставки у попередньому дописі)
'-----------
rs.MoveNext
Wend
MyFile = Dir
Wend
End Sub
|
|
|
|
Павло Жежнич
Модератор
Повідомлень: 1139
Зареєстрований: 24-11-2002
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
| Цитата: | Оригінальне повідомлення від Aндpiй
Використовуючи автоматизацію без імпорту xls-файлу в тимчасову таблицю можна
обійтись в будь-якому випадку
|
Звичайно, але тоді треба аналізувати вміст xls-файлу через об'єкти Workbook і Worksheet. А це
робить програмний код залежним від формату імпортованих файлів.
Наприклад, припустимо що ситуація поміняється і файли будуть надходити не в
xls-форматі, а в текстовому. Тоді треба буде досить сильно міняти програмний код.
|
|
|
Aндpiй
Дійсний член
Повідомлень: 128
Зареєстрований: 30-4-2003
Місто: Львів
Нема на форумі
Настрій: Настрій не вказаний
|
|
Найефективніший спосіб написання програмного коду - це метод "Copy-Paste"
|
|
|
Юрій Марків
Академік
Повідомлень: 795
Зареєстрований: 10-12-2003
Місто: Lviv
Нема на форумі
Настрій: :-)
|
|
Добрався до цього питання, вже підходить час, коли потрібно завершити...
В мене Access 2003, Microsoft Excel 11.0 Object Library.
При виконанні стрічки "rstCurr.Fields("1").Value = Time$" отримую помилку: "Run-time error '3265': Элемент
не обнаружен в данном семействе."
В чому може бути справа?
| Цитата: | Оригінальне повідомлення від Aндpiй
| Цитата: |
Sub test()
Dim rstCurr As DAO.Recordset
Dim dbsCurr As Database
Dim MyPath As String
Dim MyFile As String
Dim ShortFile As String
Dim myOlApp As Object 'об'єкт Excel
Dim MyWo As Excel.Workbook 'книга
Dim mysheet As Excel.Worksheet 'сторінка
Set myOlApp = CreateObject("excel.Application") 'встановлюємо зв'язок з Excel
MyPath = "C:\Marchello\"
Set dbsCurr = Access.CurrentDb
Set rstCurr = dbsCurr.OpenRecordset("Table1", dbOpenDynaset)
MyFile = Dir(MyPath)
Do While MyFile <> ""
Set MyWo = myOlApp.Workbooks.Open(MyPath & MyFile) 'відкриваємо документ
For Each mysheet In MyWo.Worksheets 'переглядаємо всі сторінки
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "a", MyPath & MyFile, , mysheet.Name & "$" ' тут вказуємо
додатковий параметр - яку сторінку
rstCurr.AddNew
rstCurr.Fields("1").Value = Time$
rstCurr.Fields("2").Value = Date$
rstCurr.Fields("3").Value = MyPath
rstCurr.Fields("4").Value = MyFile
rstCurr.Fields("5").Value = mysheet.Name 'це назва сторінки (додати поле в таблицю)
rstCurr.Update
Next mysheet 'беремо наступну сторінку
MyWo.Close 'звільняємо
MyFile = Dir
Loop
End Sub
|
В програмі додати в меню Сервис-ссылки: Microsoft Excel nn Object Library |
|
|
|
![[*]](images/xp/default_icon.gif){kind=icon}
