首页 > 解决方案 > vba excel以某些标准访问

问题描述

我想创建一个导入 excel 数据的访问 vba。鉴于我刚刚开始使用 vba 编程,我只能将各种代码拼凑在一起以制作最终代码。我对此进行了一些研究,但没有发现任何对我有用的东西。我会尽我所能解释我所拥有的条件。

访问数据库应包含 vba 代码。它确实有几个表,每个表都有由访问生成的主键。表名包含空格,所以我有“01 Cutlist”、“04 Panel_Data”和“08 Pallets”。我需要从两个不同的工作簿导入的数据,这意味着前两个表从一个工作簿获取数据,而最后一个表将从另一个工作簿获取数据。除了主键之外,excel中的数据与访问表的排列顺序相同。Excel 没有主键列。excel 数据分别从单元格 A7、A10 和 A5 开始。另一个问题是 excel 中的列标题并不总是与访问表标题匹配

我使用来自http://www.accessmvp.com/KDSnell/EXCEL_Import.htm的代码取得了一些成功。但是我的代码不断崩溃。以下是我到目前为止的代码

Sub E2A()
Dim xlx As Object, xlw As Object
Dim blnEXCEL As Boolean
blnEXCEL = False

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

xTab = "Step 1 - Cutlist"
aTab = "01 Cutlist"
sCell = "A7"
oFile = "_cutlist.xlsx"
a = E2A_Loop(xlx, xlw, xTab, aTab, sCell, oFile)

xTab = "Step 4 - Panel Mass"
aTab = "04 Panel_Data"
sCell = "A10"
oFile = "_cutlist.xlsx"
a = E2A_Loop(xlx, xlw, xTab, aTab, sCell, oFile)
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
End Sub

Function E2A_Loop(xlx, xlw, xTab, aTab, sCell, oFile)
Dim lngColumn As Long
Dim xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean
blnEXCEL = False

xlx.Application.ScreenUpdating = False
xlx.Visible = False
Set dbs = CurrentDb()
Set xlw = xlx.Workbooks.Open(CurrentProject.Path & "\" & Left(Application.CurrentProject.Name, 6) & oFile, , True) ' opens in read-only mode
Set xls = xlw.Worksheets(xTab)
Set xlc = xls.Range(sCell) ' this is the first cell that contains data

'Delete all records
strSQL = "Delete * From [" & aTab & "]"
dbs.Execute (strSQL)

Set rst = dbs.OpenRecordset(aTab, dbOpenDynaset, dbAppendOnly)

' write data to the recordset
Do While xlc.Value <> ""
      rst.AddNew
            For lngColumn = 0 To rst.Fields.Count - 2
                rst.Fields(lngColumn + 1).Value = xlc.Offset(0, lngColumn).Value
            Next lngColumn
      rst.Update
      Set xlc = xlc.Offset(1, 0)
Loop

rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing

End Function

标签: excelvbams-access

解决方案


推荐阅读