24

現在、次のコードを使用してワークシートから MS Access データベースにデータをエクスポートしています。コードは各行をループし、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

上記のコードは、数百行のレコードに対しては正常に機能しますが、明らかにエクスポートするデータが多くなります。25000 レコードのように、すべてのレコードをループせずにエクスポートでき、SQL INSERT ステートメントを 1 つだけ実行して、すべてのデータを Ms.Access に一括挿入できます。一気にテーブル？

どんな助けでも大歓迎です。

編集：解決された問題

誰かがこれを探している場合の情報として、私は多くの検索を行ったところ、次のコードがうまく機能することがわかりました。SQL INSERT により、非常に高速です (わずか 3 秒で 27648 レコード!!!! ):

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

「Select *」を使用する代わりに特定のフィールド名を追加する作業を続けており、フィールド名を追加するさまざまな方法を試しましたが、今のところ機能しません。

4

2 に答える 2

23

すべてのレコードをループせずにエクスポートできますか

Access.Application行数が多い Excel の範囲では、Excel でオブジェクトを作成し、それを使用してExcel データを Accessにインポートすると、パフォーマンスが向上する場合があります。以下のコードは、次のテスト データを含む同じ Excel ドキュメント内の VBA モジュールにあります。

SampleData.png

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
于 2013-04-23T08:09:32.630 に答える
0

@アーメド

以下は、MS Access に挿入する名前付き範囲のフィールドを指定するコードです。このコードの良いところは、Excel のフィールドに好きな名前を付けることができることです (* を使用する場合は、Excel と 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
于 2017-10-06T16:22:48.923 に答える