Страницы: 1
RSS
Экспорт из Excel в Access
 
Экспорт из Excel в Access  
есть заявлние в нем заполняются данные в ячейки (Фио,адрес,тел итд не) их нужно экспортировать в Access кнопкой на листе подскажите как сделать
 
Вот нашёл кое-что в запаснике:  
===========  
Вот текст достаточно универсальной функции для Access, которая загружает данные из таблицы Excel. Работает довольно медленно в силу поячеечного обращения к экселю.  
'Процедура ЗагрузкаИзExcel  
'Загрузка данных с листа Excel в соответствующую по структуре таблицу с указанием  
'номера первой строки, содержащей данные. Загрузка ведется до конца диапозона  
'параметры:  
'Таблица - имя таблицы в которую будут загружаться данные  
'Файл - полное имя файла (с путем) рабочей книги Excel  
'Лист - имя листа Excel  
'ПервСтрока - номер первой строки, содержащей данные  
Function ЗагрузкаИзExcel(Таблица As String, Файл As String, Лист, ПервСтрока As Long)  
Dim app, wb, rst As New ADODB.Recordset, i As Long, j As Integer  
On Error GoTo ErrorHandler  
Set app = CreateObject("Excel.Application")  
Set wb = app.workbooks.Open(Файл)  
rst.Open Таблица, CurrentProject.Connection, adOpenStatic, adLockOptimistic  
With wb.Worksheets(Лист)  
For i = ПервСтрока To .UsedRange.Rows.Count  
rst.AddNew  
For j = 1 To rst.Fields.Count 'Форматы таблиц должны совпадать!  
rst.Fields(j - 1) = .Cells(i, j)  
Next j  
Next i  
End With  
rst.Update  
rst.Close  
wb.Close  
GoTo Done  
ErrorHandler:  
MsgBox "Ошибка при загрузке. Ряд " & i & " Столбец " & j  
Done:  
Set rst = Nothing  
Set wb = Nothing  
Set app = Nothing  
End Function  
 
 
mastadon  
17.04.2007, 16:05  
можно с помощью функции если определить значения, а потом копировать и вставить (как значения) на старое место  
 
 
AlexeyVik  
18.04.2007, 13:09  
mikle, задача была с точностью наоборот, из Excel'я передать в Access.  
 
Вот основная часть кода "Private Sub Worksheet_Change(ByVal Target As Range)"  
.................  
Dim Baza As Database, rs As Recordset, rs1 As Recordset  
Set Baza = OpenDatabase(ThisWorkbook.Path & "\имя.mdb", False)' можно указать в кавычках полный путь к базе'  
Set rs = Baza.OpenRecordset("Имя_таблицы", dbOpenDynaset)  
Kod=Sheets("имя_листа_книги").Range("ячейка_содержащая _код")  
QryStr = "SELECT * FROM Имя_таблицы WHERE Имя_таблицы.поле =Kod"  
Set QRY1 = Baza.CreateQueryDef("")  
QRY1.Sql = QryStr  
Set rs1 = QRY1.OpenRecordset(dbOpenDynaset)  
 
Здесь добавить обработку ошибки возникающую при отсутствии такого кода.  
Если такой код есть  
rs1.Edit  
rs1.Fields("поле") = Target  
rs1.Update  
Если - нет  
rs.AddNew  
rs.Fields("имя_поля_таблицы") = Sheets("имя_листа_книги").Range("ячейка_содержащая_код")  
rs.Fields("имя_поля_таблицы") = Sheets("имя_листа_книги").Range("ячейка_содержащая_значение")  
rs.Update  
конец если  
Baza.Close  
Set rs = Nothing  
Set rs1 = Nothing  
...................  
 
 
mikle  
18.04.2007, 23:55  
задача была с точностью наоборот, из Excel'я передать в Access.Что от чего наоборот? ^_^  
 
 
makody  
20.04.2007, 15:06  
Делаем в проекте ссылку на MS ADO 2.5. после чего можно использовать следующий код:  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
 
Dim CN As ADODB.Connection  
Dim RS As ADODB.Recordset  
Dim sPath As String  
 
sPath = "C:\test.mdb"  
 
Set CN = New ADODB.Connection  
CN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sPath & ";Persist Security Info=False"  
CN.Open  
 
RS = New ADODB.Recordset  
 
RS.Open "SELECT * FROM Table1 Where NameCell=" & Trim(Target.Name), CN, adOpenStatic, adLockOptimistic  
 
If RS.EOF Then  
RS.AddNew  
RS.Fields("NameCell").Value = Trim(Target.Name)  
End If  
RS.Fields("ValueCell").Value = Target.Value  
RS.Update  
 
RS.Close  
CN.Close  
 
End Sub  
 
и еще одна ссылка  
 
http://www.delphikingdom.com/asp/answer.asp?IDAnswer=53209
 
{quote}{login=ezz}{date=15.02.2011 10:51}{thema=Экспорт из Excel в Access}{post}Экспорт из Excel в Access  
есть заявлние в нем заполняются данные в ячейки (Фио,адрес,тел итд не) их нужно экспортировать в Access кнопкой на листе подскажите как сделать{/post}{/quote}  
 
Вот вам пример  
Sub ADD_MDB()  
Dim cn As ADODB.Connection  
Dim cmd As ADODB.Command  
Dim DBFullName As String  
DBFullName = ThisWorkbook.Path & "\" & "base.mdb"  
Set cn = New ADODB.Connection  
cn.ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFullName & ""  
cn.Open  
 
Set cmd = New ADODB.Command  
  With cmd  
     .ActiveConnection = cn  
     .CommandText = "INSERT INTO TBL ( TBLname , TBLcount , TBLvalue ) VALUES (11111, '2222222', '33333333');"  
'TBL- Ваша таблица в скобках перечисляются Ваши поля в которые добавляются данные, во втрорых скобках (добавляемые значения)  
  End With  
cmd.Execute  
  cn.Close  
  Set cn = Nothing  
End Sub
Спасибо
Страницы: 1
Наверх