Question

我们提供了一个excel模板，我们流程的一部分是将该模板的所有变体加载到访问数据库中，以便更轻松地查看数据。我们在访问数据库中构建了一个宏，以帮助我们大规模验证所有数据。

当前宏会打开excel文件，然后根据不同的参数进行循环并重新计算，然后保存文件并将其传输到数据库。我将文件保持打开状态，直到完成所有传输以节省网络时间。

我目前正在通过下面的代码来完成此操作，但是却得到了不希望的结果，对access的insert调用打开了另一个具有同一文件只读版本的excel实例。该文件以后似乎没有执行任何其他操作。关于这种行为有什么想法吗？还是因为excel文件已经打开，对我来说有更好的方法吗？谢谢!!!

编辑：这实际上不符合我的期望。打开的第二个实例永不更改，并且看来JET insert语句一直在引用只读文件，而不是我打开的excel实例。

周杰伦

Sub enumerateForm()

'Create Excel application
Dim appExcel As Excel.Application
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True

'Open Form Template
wbFormTemplate = "7.31 Form 2017EY.xlsm"
Dim wbbasefile As Excel.Workbook
Set wbbasefile = appExcel.Workbooks.Open(wbFormTemplate, True, False)

 'Dim wsctrl As Excel.Worksheet
 Dim rsCubeFilters As DAO.Recordset

 Dim Cube1Val(1 To 111) As String
 Dim Cube2Val(1 To 111) As String
 Dim Cube1filter As String
 Dim cube2filter As String
 Dim filterSheet As String

'Set recordsets for the loops. This is grabbing all the pivot filters for the enumeration process
Set rsCubeFilters = CurrentDb.OpenRecordset("SELECT * FROM [Cube1Values] WHERE [Filing] = 'HHS'")


'Loops through all Enumerations
Do While rsCubeFilters.EOF = False
    'Empty the array for the cube filter
    Erase Cube1Val
    Erase Cube2Val
    filterSheet = "Pt 1 Summary of Data"

    'Cube 1 Filter Update (Situs State)
    Cube1filter = rsCubeFilters(1).Value
    wbbasefile.Sheets(filterSheet).PivotTables(filterSheet).PivotFields(Cube1filter).ClearAllFilters
    wbbasefile.Sheets(filterSheet).PivotTables(filterSheet).CubeFields(37).EnableMultiplePageItems = True
    Cube1Val(1) = rsCubeFilters(2).Value
    wbbasefile.Sheets(filterSheet).PivotTables(filterSheet).PivotFields(Cube1filter).VisibleItemsList = Array(Cube1Val)

    'Cube 2 Filter Update (Legal Entity)
    cube2filter = rsCubeFilters(3).Value
    wbbasefile.Sheets(filterSheet).PivotTables(filterSheet). _ 
PivotFields(cube2filter).ClearAllFilters
wbbasefile.Sheets(filterSheet).PivotTables(filterSheet) _
.CubeFields(11).EnableMultiplePageItems = True
Cube2Val(1) = rsCubeFilters(4).Value
wbbasefile.Sheets(filterSheet).PivotTables(filterSheet).PivotFields(cube2filter).VisibleItemsList = Array(Cube2Val)

'Refresh All Cubes
appExcel.Calculation = xlCalculationAutomatic
wbbasefile.RefreshAll
appExcel.CalculateUntilAsyncQueriesDone

wbbasefile.Save

Dim rsExcelRanges As DAO.Recordset
Dim conn As ADODB.Connection

Set rsExcelRanges = CurrentDb.OpenRecordset("SELECT * FROM [Excel Ranges] WHERE [Filing] = 'HHS'")
Set cn = CreateObject("ADODB.Connection")
 ssql = "INSERT INTO [" & rsExcelRanges(3).Value & "] "
  ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & wbFormTemplate & "].[" & rsExcelRanges(1).Value & "$" & rsExcelRanges(2).Value & "]"

  CurrentDb.Execute ssql

rsCubeFilters.MoveNext
Loop

Answer 1

在代码完成对excel文件的验证并保存后，您将需要关闭该文件以将其释放以进行编辑。只需添加几行代码即可关闭工作簿并退出excel应用程序。然后您的查询将打开可读写文件。

...
'Refresh All Cubes
appExcel.Calculation = xlCalculationAutomatic
wbbasefile.RefreshAll
appExcel.CalculateUntilAsyncQueriesDone

wbbasefile.Save
wbbasefile.Close
appExcel.quit 

Dim rsExcelRanges As DAO.Recordset
Dim conn As ADODB.Connection

Set rsExcelRanges = CurrentDb.OpenRecordset("SELECT * FROM [Excel Ranges] WHERE [Filing] = 'HHS'")
Set cn = CreateObject("ADODB.Connection")
...

将数据从打开的Excel工作表传输到Access VBA？

1 个答案: