在Acces中通过VBA运行Excelmacros

我是Access和VBA的新手，我想创build一个自动化的过程。 但是我觉得这件事我全心全意。 我试图在Access中创build一个macros：

1. 检查文件是否存在
2. 打开Excel文件并运行macros
3. 导入结果

我试图让macros运行macros，但似乎是一个失败的原因。 有人可以帮我吗？

Private Sub Main_btn_Click() Dim fileInfoToBeImported(3, 1) fileInfoToBeImported(0, 0) = "Stock_CC" fileInfoToBeImported(0, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\Stock_getdata.xlsm" fileInfoToBeImported(0, 2) = "GetStock" fileInfoToBeImported(1, 0) = "Wips_CC" fileInfoToBeImported(1, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\Wips_getdata.xlsm" fileInfoToBeImported(1, 2) = "Update" fileInfoToBeImported(2, 0) = "CCA_cc" fileInfoToBeImported(2, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\SLAcc.xls" fileInfoToBeImported(2, 2) = "Read_CCA" fileInfoToBeImported(3, 0) = "Eps_cc" fileInfoToBeImported(3, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\eps.xlsm" fileInfoToBeImported(3, 2) = "Update" '----------------------------------------------------------------------------------------------------------------------------------------- 'LOOP DOOR DE BESTANDEN '----------------------------------------------------------------------------------------------------------------------------------------- Dim loopIndex As Integer For loopIndex = 0 To UBound(fileInfoToBeImported, 1) RunMacroInExcel fileInfoToBeImported(loopIndex, 0), fileInfoToBeImported(loopIndex, 1), fileInfoToBeImported(loopIndex, 2) transferSpreadsheetFunction fileInfoToBeImported(loopIndex, 0), fileInfoToBeImported(loopIndex, 1) Next loopIndex End Sub '----------------------------------------------------------------------------------------------------------------------------------------- 'LAAT MACRO IN EXCEL LOPEN EN IMPORTEERT GEGEVENS '----------------------------------------------------------------------------------------------------------------------------------------- Private Sub RunMacroInExcel(ByVal Xl As Object) 'Step 1: Start Excel, then open the target workbook. Set Xl = CreateObject("Excel.Application") Xl.Workbooks.Open (fileInfoToBeImported(loopIndex, 0)) 'Step 2: Make Excel visible Xl.Visible = True 'Step 3: Run the target macro Xl.Run (fileInfoToBeImported(loopIndex, 2)) 'Step 4: Close and save the workbook, then close Excel Xl.ActiveWorkbook.Close (True) Xl.Quit 'Step 5: Memory Clean up. Set Xl = Nothing End Sub '----------------------------------------------------------------------------------------------------------------------------------------- 'IMPORTEERT GEGEVENS '----------------------------------------------------------------------------------------------------------------------------------------- Private Sub transferSpreadsheetFunction(ByVal tableName As String, ByVal fileName As String) If FileExist(fileName) Then DoCmd.TransferSpreadsheet acImport, , tableName, fileName, True Else Dim Msg As String Msg = "Bestand niet gevonden" & Str(Err.Number) & Err.Source & Err.Description MsgBox (Msg) End If End Sub '----------------------------------------------------------------------------------------------------------------------------------------- 'IS HET BESTAND AANWEZIG? '----------------------------------------------------------------------------------------------------------------------------------------- Function FileExist(sTestFile As String) As Boolean Dim lSize As Long On Error Resume Next lSize = -1 lSize = FileLen(sTestFile) If lSize > -1 Then FileExist = True Else FileExist = False End If End Function 

Answer 1

未经testing：

 Private Sub Main_btn_Click() Dim fileInfo(0 To 3, 0 To 2) As String Dim i As Integer fileInfo(0, 0) = "Stock_CC" fileInfo(0, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\Stock_getdata.xlsm" fileInfo(0, 2) = "GetStock" fileInfo(1, 0) = "Wips_CC" fileInfo(1, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\Wips_getdata.xlsm" fileInfo(1, 2) = "Update" fileInfo(2, 0) = "CCA_cc" fileInfo(2, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\SLAcc.xls" fileInfo(2, 2) = "Read_CCA" fileInfo(3, 0) = "Eps_cc" fileInfo(3, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\eps.xlsm" fileInfo(3, 2) = "Update" For i = 0 To UBound(fileInfo, 1) RunMacroInExcel fileInfo(i, 1), _ fileInfo(i, 2) transferSpreadsheetFunction fileInfo(i, 0), fileInfo(i, 1) Next i End Sub Private Sub RunMacroInExcel(fName As String, macroName As String) Dim XL As Object, wb As Object Set XL = CreateObject("Excel.Application") XL.Visible = True Set wb = XL.Workbooks.Open(fName) XL.Run macroName wb.Close True XL.Quit Set XL = Nothing End Sub Private Sub transferSpreadsheetFunction(ByVal tableName As String, ByVal fileName As String) Dim Msg As String If FileExist(fileName) Then DoCmd.TransferSpreadsheet acImport, , tableName, fileName, True Else Msg = "Bestand niet gevonden " & Str(Err.Number) & Err.Source & Err.Description MsgBox Msg End If End Sub Function FileExist(sTestFile As String) As Boolean FileExist = (Len(Dir(sTestFile, vbNormal)) > 0) End Function