Question

我是Access和VBA的新手，我想创建一个自动化流程。但是我觉得我对这个问题一直都很满意。我试图在Access中创建一个宏：

检查文件是否存在
打开excel文件并运行宏
导入结果

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

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

在Acces中通过VBA运行Excel宏

1 个答案: