无法将logging从访问拉到excel，可能的连接问题
我使用下面的代码将访问logging从Excel中提取出来。 我得到错误
connDB.Open ConnectionString：=“Provider = Microsoft.ACE.OLEDB.12.0; data source =”＆strDB
错误说“无效的sql语句，删除，插入，程序，selet或更新”
请帮忙，因为我卡住了，根本无法前进….
请帮忙。
Sub automateAccessADO_9（）'使用ADO将数据从Access数据库表导入Excel工作表（您的主机应用程序）。 '参考图9a查看MS Access文件“SalesReport.accdb”中的现有SalesManager表。
'要在VBA项目中使用ADO，必须通过单击VBE中的“工具 – 参考”，在Excel（您的主机应用程序）中添加对ADO对象库的引用，然后从列表中select适当版本的Microsoft ActiveX Data Objects xx Library 。
'-------------- 'DIM STATEMENTS Dim strMyPath As String, strDBName As String, strDB As String, strSQL As String Dim i As Long, n As Long, lFieldCount As Long Dim rng As Range 'instantiate an ADO object using Dim with the New keyword: Dim adoRecSet As New ADODB.Recordset Dim connDB As New ADODB.Connection '-------------- 'THE CONNECTION OBJECT strDBName = "Computer.accdb" strMyPath = ThisWorkbook.Path strDB = strMyPath & "\" & strDBName 'Connect to a data source: 'For pre - MS Access 2007, .mdb files (viz. MS Access 97 up to MS Access 2003), use the Jet provider: "Microsoft.Jet.OLEDB.4.0". For Access 2007 (.accdb database) use the ACE Provider: "Microsoft.ACE.OLEDB.12.0". The ACE Provider can be used for both the Access .mdb & .accdb files. connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB '-------------- 'OPEN RECORDSET, ACCESS RECORDS AND FIELDS Dim ws As Worksheet 'set the worksheet: Set ws = ActiveWorkbook.Sheets("Sheet1") 'Set the ADO Recordset object: Set adoRecSet = New ADODB.Recordset 'Opening the table named SalesManager: strTable = "memory" '-------------- 'COPY RECORDS FROM ALL FIELDS OF A RECORDSET: 'refer Image 9d to view records copied to Excel worksheet adoRecSet.Open Source:=strTable, ActiveConnection:=connDB, CursorType:=adOpenStatic, LockType:=adLockOptimistic Set rng = ws.Range("A1") lFieldCount = adoRecSet.Fields.Count For i = 0 To lFieldCount - 1 'copy column names in first row of the worksheet: rng.Offset(0, i).Value = adoRecSet.Fields(i).Name adoRecSet.MoveFirst 'copy record values starting from second row of the worksheet: n = 1 Do While Not adoRecSet.EOF rng.Offset(n, i).Value = adoRecSet.Fields(i).Value adoRecSet.MoveNext n = n + 1 Loop Next i 'select column range to AutoFit column width: Range(ws.Columns(1), ws.Columns(lFieldCount)).AutoFit 'worksheet columns are deleted because this code is only for demo: Range(ws.Columns(1), ws.Columns(lFieldCount)).Delete adoRecSet.Close 'close the objects connDB.Close 'destroy the variables Set adoRecSet = Nothing Set connDB = Nothing End Sub 从Access到Excel时，您有很多select！
这是将数据从Access导出到Excel的一种方法。
Dim lngColumn As Long Dim xlx As Object, xlw As Object, xls As Object, xlc As Object Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim blnEXCEL As Boolean, blnHeaderRow As Boolean blnEXCEL = False ' Replace True with False if you do not want the first row of ' the worksheet to be a header row (the names of the fields ' from the recordset) blnHeaderRow = True ' Establish an EXCEL application object On Error Resume Next Set xlx = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set xlx = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change True to False if you do not want the workbook to be ' visible when the code is running xlx.Visible = True ' Replace C:\Filename.xls with the actual path and filename ' of the EXCEL file into which you will write the data Set xlw = xlx.Workbooks.Open("C:\Filename.xls") ' Replace WorksheetName with the actual name of the worksheet ' in the EXCEL file ' (note that the worksheet must already be in the EXCEL file) Set xls = xlw.Worksheets("WorksheetName") ' Replace A1 with the cell reference into which the first data value ' is to be written Set xlc = xls.Range("A1") ' this is the first cell into which data go Set dbs = CurrentDb() ' Replace QueryOrTableName with the real name of the table or query ' whose data are to be written into the worksheet Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly) If rst.EOF = False And rst.BOF = False Then rst.MoveFirst If blnHeaderRow = True Then For lngColumn = 0 To rst.Fields.Count - 1 xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name Next lngColumn Set xlc = xlc.Offset(1,0) End If ' write data to worksheet Do While rst.EOF = False For lngColumn = 0 To rst.Fields.Count - 1 xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value Next lngColumn rst.MoveNext Set xlc = xlc.Offset(1,0) Loop End If rst.Close Set rst = Nothing dbs.Close Set dbs = Nothing ' Close the EXCEL file while saving the file, and clean up the EXCEL objects Set xlc = Nothing Set xls = Nothing xlw.Close True ' close the EXCEL file and save the new data Set xlw = Nothing If blnEXCEL = True Then xlx.Quit Set xlx = Nothing
这是另一种方式。
Dim lngColumn As Long Dim xlx As Object, xlw As Object, xls As Object, xlc As Object Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim strPathFileName As String, strWorksheetName As String Dim strRecordsetDataSource As String Dim blnEXCEL As Boolean, blnHeaderRow As Boolean blnEXCEL = False ' Replace C:\Filename.xls with the actual path and filename ' that will be used to save the new EXCEL file into which you ' will write the data strPathFileName = "C:\Filename.xls" ' Replace QueryOrTableName with the real name of the table or query ' whose data are to be written into the worksheet strRecordsetDataSource = "QueryOrTableName" ' Replace True with False if you do not want the first row of ' the worksheet to be a header row (the names of the fields ' from the recordset) blnHeaderRow = True ' Establish an EXCEL application object On Error Resume Next Set xlx = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set xlx = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change True to False if you do not want the workbook to be ' visible when the code is running xlx.Visible = True ' Create a new EXCEL workbook Set xlw = xlx.Workbooks.Add ' Rename the first worksheet in the EXCEL file to be the first 31 ' characters of the string in the strRecordsetDataSource variable Set xls = xlw.Worksheets(1) xls.Name = Trim(Left(strRecordsetDataSource, 31)) ' Replace A1 with the cell reference of the first cell into which the ' headers will be written (blnHeaderRow = True), or into which the data ' values will be written (blnHeaderRow = False) Set xlc = xls.Range("A1") Set dbs = CurrentDb() Set rst = dbs.OpenRecordset(strRecordsetDataSource, dbOpenDynaset, dbReadOnly) If rst.EOF = False And rst.BOF = False Then ' Write the header row to worksheet If blnHeaderRow = True Then For lngColumn = 0 To rst.Fields.Count - 1 xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name Next lngColumn Set xlc = xlc.Offset(1,0) End If ' copy the recordset's data to worksheet xlc.CopyFromRecordset rst End If rst.Close Set rst = Nothing dbs.Close Set dbs = Nothing ' Save and close the EXCEL file, and clean up the EXCEL objects Set xlc = Nothing Set xls = Nothing xlw.SaveAs strPathFileName xlw.Close False Set xlw = Nothing If blnEXCEL = True Then xlx.Quit Set xlx = Nothing
这是一种从Access到Excel导入date的方法。
Sub ADOImportFromAccessTable(DBFullName As String, _ TableName As String, TargetRange As Range) ' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _ "TableName", Range("C1") Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer Set TargetRange = TargetRange.Cells(1, 1) ' open the database Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _ DBFullName & ";" Set rs = New ADODB.Recordset With rs ' open the recordset .Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable ' all records '.Open "SELECT * FROM " & TableName & _ " WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText ' filter records RS2WS rs, TargetRange ' write data from the recordset to the worksheet ' ' optional approach for Excel 2000 or later (RS2WS is not necessary) ' For intColIndex = 0 To rs.Fields.Count - 1 ' the field names ' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name ' Next ' TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data End With rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub
这是导入数据的另一种方法。
Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _ FieldName As String, TargetRange As Range) ' Example: DAOCopyFromRecordSet "C:\FolderName\DataBaseName.mdb", _ "TableName", "FieldName", Range("C1") Dim db As Database, rs As Recordset Dim intColIndex As Integer Set TargetRange = TargetRange.Cells(1, 1) Set db = OpenDatabase(DBFullName) Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records 'Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _ " WHERE " & FieldName & _ " = 'MyCriteria'", dbReadOnly) ' filter records ' write field names For intColIndex = 0 To rs.Fields.Count - 1 TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name Next ' write recordset TargetRange.Offset(1, 0).CopyFromRecordset rs Set rs = Nothing db.Close Set db = Nothing End Sub