Форум Рідного Міста

VBA for Access

Юрій Марків - 31-1-2009 у 16:57

Привіт, люди!

Така задачка.
Імпортую один екселівський файл в Access за допомогою коду VBA

Цитата:

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "TableName", "C:\File.xls"

Тим часом знадобилося імпортувати в окремі таблиці кілька сотень таких файлів, імена файлів вказані в таблиці Access table3, таблиці повинні називатися так, як файли.

Хтось підкаже, як це зробити?

Юрій Марків - 31-1-2009 у 21:56

Я тут по ходу п'єси вже дещо накалякав для імпорту купи файлів у таблиці 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: створення, зміна чи вилучення

Я на програміста ніколи не вчився...
Можливо, хтось щось підкаже?

Юрій Марків - 1-2-2009 у 11:29

Поки ніхто не відповідає, пишу сюди, що наразі в мене вийшло...

Ось приклад таблиці 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й - 1-2-2009 у 13:28

Не спрацьовує тому, що В 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

Юрій Марків - 1-2-2009 у 14:14

Цитата:

Оригінальне повідомлення від Aндpiй
стоїть умова відбирати лише порожні значення із вхідної таблиці, а нам треба - лише непорожні, тобто

Set rstIn = db.OpenRecordset("SELECT F2 " & _
"FROM [" & tdf.Name & "] " & _
"WHERE Len(F2 & """") > 0")

Дякую, Андрію!

))))
Нарешті від вчорашнього ранку помиюся, переодягнуся, поїм і взагалі вийду на вулицю!

Павло Жежнич - 1-2-2009 у 14:16

Питання/пропозиції:
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й - 1-2-2009 у 14:40

Павло Жежнич,
пожалійте людину - він же сказав, що на програміста ніколи не вчився

Юрій Марків - 1-2-2009 у 14:43

Цитата:

Оригінальне повідомлення від Aндpiй
Павло Жежнич,
пожалійте людину - він же сказав, що на програміста ніколи не вчився

Та все одно дуже дякую за участь, Павло!

Павло Жежнич - 2-2-2009 у 13:41

Цитата:

Якщо людина на програміста не вчилася, то вона повинна бути зацікавлена писати як найменше програмного коду!

Я власне це рекомендую.
А написання SQL-запитів - це не програмування - один "правильний" запит може замінити десятки стрічок програмного коду.

Aндpiй - 2-2-2009 у 14:52

Цитата:

Якщо людина на програміста не вчилася, то вона повинна бути зацікавлена писати як найменше програмного коду! Я власне це рекомендую.

Я думаю, що п.Юрію, хоча він робить перші кроки, вдалось написати власноруч менше коду, ніж найбільшому асу в програмуванні :sing:

Пане Павле - цікаво було б побачити ваш варіант рішення цієї задачі за допомогою SQL без використання VBA

Юрій Марків - 2-2-2009 у 23:51

Ще цікавить, як витягнути кожну назву листа екселівського файлу і додати в таблицю tblOutput

Цитата:

rstOut!Field4 = ...

Aндpiй - 3-2-2009 у 11:02

П.Юрію, доведеться використовувати інший підхід, який до-речі, дозволяє відмовитися від 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

Павло Жежнич - 3-2-2009 у 12:31

Цитата:

Оригінальне повідомлення від 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й - 3-2-2009 у 12:43

Використовуючи автоматизацію без імпорту xls-файлу в тимчасову таблицю можна обійтись в будь-якому випадку

Павло Жежнич - 3-2-2009 у 12:53

Спочатку треба зробити копію одного з файлів у 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

Павло Жежнич - 3-2-2009 у 13:00

Цитата:

Оригінальне повідомлення від Aндpiй
Використовуючи автоматизацію без імпорту xls-файлу в тимчасову таблицю можна обійтись в будь-якому випадку

Звичайно, але тоді треба аналізувати вміст xls-файлу через об'єкти Workbook і Worksheet. А це робить програмний код залежним від формату імпортованих файлів.

Наприклад, припустимо що ситуація поміняється і файли будуть надходити не в xls-форматі, а в текстовому. Тоді треба буде досить сильно міняти програмний код.

Aндpiй - 3-2-2009 у 13:46

Найефективніший спосіб написання програмного коду - це метод "Copy-Paste" :lol:

Юрій Марків - 14-2-2009 у 09:58

Добрався до цього питання, вже підходить час, коли потрібно завершити...

В мене Access 2003, Microsoft Excel 11.0 Object Library.

При виконанні стрічки "rstCurr.Fields("1").Value = Time$" отримую помилку: "Run-time error '3265': Элемент не обнаружен в данном семействе."

В чому може бути справа?

Цитата:

Оригінальне повідомлення від Aндpiй

Цитата:

В програмі додати в меню Сервис-ссылки: Microsoft Excel nn Object Library