使用ExcelVBA将数据导出到MS Access表

内容来源于 Stack Overflow,并遵循CC BY-SA 3.0许可协议进行翻译与使用

  • 回答 (2)
  • 关注 (0)
  • 查看 (15)

我目前正在使用下面的代码将数据从工作表导出到MS Access数据库,代码正在遍历每一行并将数据插入到MS Access Table。

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

上面的代码可以用于几百行记录,但是很明显,它将是更多的数据导出,就像25000条记录,是否可以在不循环遍历所有记录的情况下导出,只需要一个SQLINSERT语句就可以一次性将所有数据批量插入到Ms.AccessTable?

提问于
用户回答回答于

是否可以不通过循环遍历所有记录而导出?

对于Excel中包含大量行的范围,如果创建Access.Application对象,然后将其用于进口Excel数据进入Access。下面的代码位于包含以下测试数据的同一个Excel文档中的VBA模块中

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
用户回答回答于

下面是代码,它指定了从指定范围插入到MS Access中的字段。这段代码的好处是,可以在Excel中任意命名字段(如果您使用的话)。然后,这些字段必须在Excel和Access之间完全匹配),正如所看到的,我已经将Excel列命名为“Haha”,尽管Access列名为“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

扫码关注云+社区