所以基本上我希望能够从excel发送日期访问,运行一些查询,并将结果发送回excel,并从excel VBA完成所有这些。
我想发送我的数据,这是一张excel工作表,其中包含工作表名称" Enrollment Data Aggregate"到访问数据库H:\我的文件扩展名\ Nameofdatabase.accdb并将其保存为名为"注册数据聚合"的表。
我已经有了从表格#34; Enrollment Data Aggregate"开始的查询,所以我认为(希望)我可以删除该表,当我从excel中提取新表时,查询仍将更新。然后我想访问运行/更新查询并将它们作为单独的选项卡导出到我的excel文件。
理想情况下,我希望继续在excel VBA中做其他事情。换句话说,我真的希望我可以从excel控制所有这些。我有很多excel和access的经验,但是我只做了大约4个像这样大的VBA项目(我已经完成了很多小的宏)所以我没有超级经验。任何建议都将不胜感激。
答案 0 :(得分:2)
将数据从Excel导出到Access:
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\FolderName\DataBaseName.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
要将数据从Access导入Excel:
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
从Excel运行Access查询:
Sub CreateAndRunQuery()
'------------------------------------------------------------------------------------------
'This macro opens the Sample.accdb database, creates and runs an SQL query (filtering
'all the customers from Canada). Then, it copies selected fields back in the Excel sheet.
'The code uses late binding, so no reference to external library is required.
'Written By: Christos Samaras
'Date: 05/10/2013
'Last Updated: 29/11/2014
'E-mail: xristos.samaras@gmail.com
'Site: http://www.myengineeringworld.net
'------------------------------------------------------------------------------------------
'Declaring the necessary variables.
Dim con As Object
Dim rs As Object
Dim AccessFile As String
Dim strTable As String
Dim SQL As String
Dim i As Integer
'Disable screen flickering.
Application.ScreenUpdating = False
'Specify the file path of the accdb file. You can also use the full path of the file like:
'AccessFile = "C:\Users\Christos\Desktop\Sample.accdb"
AccessFile = ThisWorkbook.Path & "\" & "Sample.accdb"
'Set the name of the table you want to retrieve the data.
strTable = "Customers"
On Error Resume Next
'Create the ADODB connection object.
Set con = CreateObject("ADODB.connection")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection Error"
Exit Sub
End If
On Error GoTo 0
'Open the connection.
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
'Create the SQL statement to retrieve the data from table.
'Get the necessary information (first name etc.) for all the Canadian customers.
SQL = "SELECT FirstName, LastName, Address, City, Phone FROM " & strTable & " WHERE COUNTRY='Canada'"
On Error Resume Next
'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.Recordset")
'Check if the object was created.
If Err.Number <> 0 Then
'Error! Release the objects and exit.
Set rs = Nothing
Set con = Nothing
'Display an error message to the user.
MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
Exit Sub
End If
On Error GoTo 0
'Set thee cursor location.
rs.CursorLocation = 3 'adUseClient on early binding
rs.CursorType = 1 'adOpenKeyset on early binding
'Open the recordset.
rs.Open SQL, con
'Check if the recordet is empty.
If rs.EOF And rs.BOF Then
'Close the recordet and the connection.
rs.Close
con.Close
'Release the objects.
Set rs = Nothing
Set con = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'In case of an empty recordset display an error.
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
'Copy the recordset headers.
For i = 0 To rs.Fields.Count - 1
Sheets("New Query").Cells(1, i + 1) = rs.Fields(i).Name
Next i
'Write the query values in the sheet.
Sheets("New Query").Range("A2").CopyFromRecordset rs
'Close the recordet and the connection.
rs.Close
con.Close
'Release the objects.
Set rs = Nothing
Set con = Nothing
'Adjust the columns' width.
Sheets("New Query").Columns("A:E").AutoFit
'Enable the screen.
Application.ScreenUpdating = True
'Inform the user that the macro was executed successfully.
MsgBox "The Canadian customers were successfully retrieved from the '" & strTable & "' table!", vbInformation, "Done"
End Sub
您可以在此处找到更多信息。
http://www.myengineeringworld.net/2013/10/running-access-queries-from-excel-vba.html