Używanie programu Excel VBA do eksportowania danych do tabeli MS Access
Obecnie używam poniższego kodu do eksportu danych z arkusza roboczego do bazy danych MS Access, kod zapętla się przez każdy wiersz i wstawia dane do tabeli MS Access.
Public Sub TransData()
Application.ScreenUpdating = False
Application.EnableAnimations = False
Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Folio_Data_original").Activate
Call MakeConnection("fdMasterTemp")
For i = 1 To rcount - 1
rs.AddNew
rs.Fields("fdName") = Cells(i + 1, 1).Value
rs.Fields("fdDate") = Cells(i + 1, 2).Value
rs.Update
Next i
Call CloseConnection
Application.ScreenUpdating = True
Application.EnableAnimations = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Public Function MakeConnection(TableName As String) As Boolean
'*********Routine to establish connection with database
Dim DBFullName As String
Dim cs As String
DBFullName = Application.ActiveWorkbook.Path & "\FDData.mdb"
cs = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set cn = CreateObject("ADODB.Connection")
If Not (cn.State = adStateOpen) Then
cn.Open cs
End If
Set rs = CreateObject("ADODB.Recordset")
If Not (rs.State = adStateOpen) Then
rs.Open TableName, cn, adOpenKeyset, adLockOptimistic
End If
End Function
Public Function CloseConnection() As Boolean
'*********Routine to close connection with database
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
End If
If Not cn Is Nothing Then
cn.Close
End If
CloseConnection = True
Exit Function
End Function
Powyższy kod działa dobrze dla kilkuset wierszy rekordów, ale widocznie będzie więcej danych do eksportu, jak 25000 rekordów, czy można eksportować bez zapętlania wszystkich rekordów i tylko jedną instrukcję SQL INSERT, aby zbiorczo wstawić wszystkie dane do tabeli MS. Access w jednym iść?
Każda pomoc będzie mile widziana.EDIT: PROBLEM ROZWIĄZANY
Tylko dla informacji, jeśli ktoś szuka tego, zrobiłem wiele poszukiwań i znalazłem następujący kod, który działa dobrze dla mnie, i jest naprawdę szybki ze względu na SQL INSERT, (27648 rekordów w zaledwie 3 sekundy!!!!):
Public Sub DoTrans()
Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "\FDData.mdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO fdFolio ([fdName], [fdOne], [fdTwo]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
cn.Execute ssql
End Sub
Wciąż pracuję nad dodaniem nazw określonych pól zamiast "Select*", próbowałem różnych sposobów dodawania nazw pól, ale na razie nie mogę tego zrobić.
2 answers
Czy Można eksportować bez zapętlania wszystkich rekordów
Dla zakresu w programie Excel z dużą liczbą wierszy może pojawić się poprawa wydajności, jeśli utworzysz obiekt Access.Application
w programie Excel, a następnie użyjesz go do zaimportuj Dane programu Excel do programu Access. Poniższy kod znajduje się w module VBA w tym samym dokumencie Excel, który zawiera następujące dane testowe
Option Explicit
Sub AccImport()
Dim acc As New Access.Application
acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"
acc.DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:="tblExcelImport", _
Filename:=Application.ActiveWorkbook.FullName, _
HasFieldNames:=True, _
Range:="Folio_Data_original$A1:B10"
acc.CloseCurrentDatabase
acc.Quit
Set acc = Nothing
End Sub
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2014-09-10 14:11:13
@Ahmed
Poniżej znajduje się kod, który określa pola z nazwanego zakresu do wstawienia do MS Access. Fajną rzeczą w tym kodzie jest to, że możesz nazwać swoje pola w Excelu, co do cholery chcesz (jeśli używasz *, To pola muszą pasować dokładnie między Excelem a Access), jak widać nazwałem kolumnę Excela "Haha", mimo że kolumna dostępu nazywa się "dte".
Sub test()
dbWb = Application.ActiveWorkbook.FullName
dsh = "[" & Application.ActiveSheet.Name & "$]" & "Data2" 'Data2 is a named range
sdbpath = "C:\Users\myname\Desktop\Database2.mdb"
sCommand = "INSERT INTO [main] ([dte], [test1], [values], [values2]) SELECT [haha],[test1],[values],[values2] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
Dim dbCon As New ADODB.Connection
Dim dbCommand As New ADODB.Command
dbCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdbpath & "; Jet OLEDB:Database Password=;"
dbCommand.ActiveConnection = dbCon
dbCommand.CommandText = sCommand
dbCommand.Execute
dbCon.Close
End Sub
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2017-10-06 16:35:14