通過Acces中的VBA運行Excel宏

Question

我是Access和VBA的新手，我想創建一個自動化過程。 但我覺得我對這個問題一無所知。我試圖做一個宏訪問：

1. 檢查文件是否存在
2. 打開Excel文件並運行宏
3. 進口的結果

我想讓宏運行宏，但它似乎是一個失敗的原因。 有人可以幫助我嗎？

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

未經測試：

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