VBNet - Форум - Экспорт данных из Access'а в Excel

Вопрос: Экспорт данных из Access'а в Excel Добавлено: 23.08.05 16:41

Автор вопроса: Antonina | ICQ: 438654946

Здравствуйте уважаемые обитатели форума!
Нуждаюсь в вашей помощи.
Подскажите, пожалуйста, возможно ли программным путем осуществить экспорт access’овского запроса в excel’евскую таблицу? Если возможно, то каким образом?
Больше года не занималась ничем подобным, и уже вообще ничего не помню. 

Заранее благодарю.
Ответить

Ответы Всего ответов: 9

Номер ответа: 1 Автор ответа: AndreyMp ICQ: 237822510 Вопросов: 28 Ответов: 1182	Профиль \| \| #1	Добавлено: 23.08.05 17:57
	Обычно я использую Access и Exel как таблицы данных, и использую их из VB. Если интересует, то где то у меня валялись процедурки на VB экспорта, импорта из Access в Exel и обратно. Ответить

Номер ответа: 2 Автор ответа: vito Разработчик Offline Client Вопросов: 23 Ответов: 879	Web-сайт: softvito.narod2.ru Профиль \| \| #2	Добавлено: 23.08.05 19:52
	Вот пример из хелпа. Sub CreateQueryDefX() Dim dbsNorthwind As Database Dim qdfTemp As QueryDef Dim qdfNew As QueryDef Set dbsNorthwind = OpenDatabase("Northwind.mdb" With dbsNorthwind ' Create temporary QueryDef. Set qdfTemp = .CreateQueryDef("", _ "SELECT * FROM Employees" ' Open Recordset and print report. GetrstTemp qdfTemp ' Create permanent QueryDef. Set qdfNew = .CreateQueryDef("NewQueryDef", _ "SELECT * FROM Categories" ' Open Recordset and print report. GetrstTemp qdfNew ' Delete new QueryDef because this is a demonstration. .QueryDefs.Delete qdfNew.Name .Close End With End Sub Function GetrstTemp(qdfTemp As QueryDef) Dim rstTemp As Recordset With qdfTemp Debug.Print .Name Debug.Print " " & .SQL ' Open Recordset from QueryDef. Set rstTemp = .OpenRecordset(dbOpenSnapshot) With rstTemp ' Populate Recordset and print number of records. .MoveLast Debug.Print " Number of records = " & _ .RecordCount Debug.Print .Close End With End With End Function Метод CreateQueryDef Ответить

Номер ответа: 3 Автор ответа: *Antonina* ICQ: 438654946 Вопросов: 6 Ответов: 29	Профиль \| \| #3	Добавлено: 25.08.05 13:13
	Андрей, буду очень признательна, если поделишься своими замечательными процедурками. vito, сенкс. Ответить

Номер ответа: 4 Автор ответа: AndreyMp ICQ: 237822510 Вопросов: 28 Ответов: 1182	Профиль \| \| #4	Добавлено: 25.08.05 13:46
	Хорошо. Проекты с этим я писал давно, где то дома должны быть. Постараюсь выложить. Просто сейчас заново писать времени нет. Ответить

Номер ответа: 5 Автор ответа: AndreyMp ICQ: 237822510 Вопросов: 28 Ответов: 1182	Профиль \| \| #5	Добавлено: 28.08.05 21:59
	Извини что долго, погода подвела. Молния ударила в транс и три дня света не было, а на упээсе долго не протянешь.Выкладываю пока линк экспорта из Access в Excel, пришлось маленько переделать,но с DAO работает, с ADO не проверял. Надо подключить библу Microsoft Excel 10.0 Object Library. Private Sub AccessToExcel(RecAccess As DAO.Recordset, SaveExcelFile As String)'вместо DAO может стоять ADODB, а SaveExcelFile - путь к xls файлу, он не обязательно должен существовать Dim fldLoop As Field Dim k As Long Dim j As Long 'Экспорт в Excel Dim Ex As Excel.Application Set Ex = New Excel.Application k = 1 Ex.Workbooks.Add ' Делаем заголовок,т.е. имена полей For Each fldLoop In RecAccess.Fields Ex.ActiveSheet.Cells(1, k).Value = fldLoop.Name 'имена полей Ex.ActiveSheet.Cells(1, k).Borders.LineStyle = xlDouble 'двойная линия окантовки Ex.ActiveSheet.Cells(1, k).WrapText = True ' Ex.ActiveSheet.Rows(1).Font.Bold = True ' жирный шрифт Ex.ActiveSheet.Cells(1, k).HorizontalAlignment = xlCenter 'по центру горизонталь Ex.ActiveSheet.Cells(1, k).VerticalAlignment = xlCenter 'по центру вертикаль k = k + 1 Next fldLoop ' Заполняем данными j = 2 If RecAccess.RecordCount <> 0 Then RecAccess.MoveFirst Do k = 1 For Each fldLoop In RecAccess.Fields Ex.ActiveSheet.Cells(j, k).Value = fldLoop.Value Ex.ActiveSheet.Cells(j, k).HorizontalAlignment = xlLeft Ex.ActiveSheet.Cells(j, k).Borders.LineStyle = xlContinuous Ex.ActiveSheet.Cells(j, k).WrapText = True Ex.ActiveSheet.Cells(j, k).VerticalAlignment = xlCenter k = k + 1 Next fldLoop j = j + 1 RecAccess.MoveNext Loop Until RecAccess.EOF End If Ex.ActiveWorkbook.SaveAs SaveExcelFile Ex.ActiveWorkbook.Close False Ex.Quit Set Ex = Nothing End Sub Ответить

Номер ответа: 6 Автор ответа: *Antonina* ICQ: 438654946 Вопросов: 6 Ответов: 29	Профиль \| \| #6	Добавлено: 30.08.05 15:47
	Андрей, ты мой спаситель! Спасибо тебе огромное!!! Ответить

Номер ответа: 7 Автор ответа: AndreyMp ICQ: 237822510 Вопросов: 28 Ответов: 1182	Профиль \| \| #7	Добавлено: 30.08.05 16:46
	Не за что. Заходи почаще (на форум в смысле). Да, я что то подзабыл и ты не напомнишь, обратную то процедуру надо или сама справишься? Ответить

Номер ответа: 8 Автор ответа: *Antonina* ICQ: 438654946 Вопросов: 6 Ответов: 29	Профиль \| \| #8	Добавлено: 31.08.05 09:40
	Андрей, я попробую самостоятельно справится... Надо же когда-нибудь начинать восстанавливать навыки. Ответить

Номер ответа: 9 Автор ответа: HACKER Разработчик Offline Client Вопросов: 236 Ответов: 8362	Профиль \| \| #9	Добавлено: 31.08.05 17:03
	Ну и как вариант через ADO, а принцип с экселем тот же... Public Function Export2XL(InitRow As Long, DBAccess As String, DBTable As String) As Long '+ ' Экспортирует с базы в Exel Dim cn As New ADODB.Connection 'Use for the connection string Dim cmd As New ADODB.Command 'Use for the command for the DB Dim rs As New ADODB.Recordset 'Recordset return from the DB Dim MyIndex As Integer 'Used for Index Dim MyRecordCount As Long 'Store the number of record on the table Dim MyFieldCount As Integer 'Store the number of fields or column Dim ApExcel As Object 'To open Excel Dim MyCol As String Dim Response As Integer Set ApExcel = CreateObject("Excel.application" 'Creates an object ApExcel.Visible = True 'This enable you to see the process in Excel ApExcel.Workbooks.Add 'Adds a new book. 'Set the connection string cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0ata Source=" & DBAccess 'Open the connection cn.Open 'Check that the connection is open If cn.State = 0 Then cn.Open Set cmd.ActiveConnection = cn cmd.CommandText = DBTable cmd.CommandType = adCmdTable Set rs = cmd.Execute 'Count the number of fields or column MyFieldCount = rs.Fields.Count 'Fill the first line with the name of the fields For MyIndex = 0 To MyFieldCount - 1 ApExcel.Cells(InitRow, (MyIndex + 1)).Formula = rs.Fields(MyIndex).Name 'Write Title to a Cell ApExcel.Cells(InitRow, (MyIndex + 1)).Font.Bold = True ApExcel.Cells(InitRow, (MyIndex + 1)).interior.colorindex = 36 ApExcel.Cells(InitRow, (MyIndex + 1)).WrapText = True Next 'Draw border on the title line MyCol = Chr((64 + MyIndex)) & InitRow ApExcel.Range("A" & InitRow & ":" & MyCol).Borders.Color = RGB(0, 0, 0) MyRecordCount = 1 + InitRow 'Fill the excel book with the values from the database Do While rs.EOF = False For MyIndex = 1 To MyFieldCount ApExcel.Cells(MyRecordCount, MyIndex).Formula = rs((MyIndex - 1)).Value 'Write Value to a Cell ApExcel.Cells(MyRecordCount, MyIndex).WrapText = False 'Format the Cell Next MyRecordCount = MyRecordCount + 1 rs.MoveNext If MyRecordCount > 50 Then Exit Do End If Loop 'Close the connection with the DB rs.Close 'Return the last position in the workbook Export2XL = MyRecordCount End Function Ответить

Страница: 1 |