使用 MS Access 在 excel vba 中运行代码

Question

I pull a query off SQL Server using an access front-end. I then export the recordset to a new Excel workbook. I want to then use excel to run code that I have in Access. It simply loops through cells and adds formatting and checks for a certain value. I can run it from access which will it has the workbook opens loops through fine. However it is painfully slow.

If I go into excel and paste the code that access is running for the formatting and check. It runs within seconds. But running it from access takes over 10 minutes.

Anyone got any ideas if this can be done?

Answer 1

I've put this code in the "ThisWorkbook" object in Excel:

Public Sub TestScript()

    Debug.Print "Hello"

End Sub

And then successfully called it from Access using a button on a form:

Private Sub cmdRunExcel_Click()

    Dim xl As Excel.Application
    Set xl = CreateObject("Excel.Application")

    xl.Visible = True

    xl.Workbooks.Open "C:/Your/FolderPath/And/FileName.xlsx", True, False

    xl.Run "ThisWorkbook.TestScript"

    Set xl = Nothing

End Sub

Admittedly I've not given it a lot of code to run, but here the code is at least running on Excel, from Excel ... which must be better than trying to run code on Excel from Access.

Update : See if you can create the module from Access to Excel by testing this (I can't test it properly because I'm using a work computer and it seems to be not letting me run this type of code due to security settings)

Private Sub cmdRunExcel_Click()

    Dim xl As Excel.Application
    Dim myWrkBk As Excel.Workbook
    Dim myModule As VBComponent
    Dim strVb As String

    Set xl = CreateObject("Excel.Application")

    xl.Visible = True

    xl.Workbooks.Open "C:/Your/FolderPath/And/FileName.xlsx", True, False

    Set myWrkBk = xl.Workbooks.Add
    Set myModule = myWrkBk.VBProject.VBComponents.Add(vbext_ct_StdModule)

    strVb = "Public Sub TestScript()" & vbCrLf _
          & "Debug.Print 'Hello'" _
          & "End Sub"

    myModule.CodeModule.AddFromString strVb

'    xl.Run "ThisWorkbook.TestScript"

    Set myModule = Nothing
    Set myWrkBk = Nothing
    Set xl = Nothing

End Sub

Answer 2

If I understood you correctly, that you copied a code from Access to Excel and run the same code in Excel, in both cases the code manipulates the spreadsheet, and the one in Excel is fast, and the other in Access is slow, you can try the following:

• hide Excel window ( ActiveWorkbook.Windows(1).Visible = False ), check also here
• halt recalculation of the worksheet - check this
• write the same function in Excel sheet (as a template file) and only run it from Access

I hope this helps.

Normally, automation is much slower than a macro (vba code). The same applies to other applications, eg. MS Word.

Answer 3

If the code you wish to run in Excel always is the same, then open an Excel template with a macro workbook attached holding your code. Then, from Access, you can run a series of macros or, of course, only one macro if only one is passed to the parameter array:

Function RunExcelMacros( _
  ByVal strFileName As String, _
  ParamArray avarMacros()) As Boolean

Debug.Print "xl ini", Time

  On Error GoTo Err_RunExcelMacros

  Static xlApp      As Excel.Application
  Dim xlWkb         As Excel.Workbook

  Dim varMacro      As Variant
  Dim booSuccess    As Boolean
  Dim booTerminate  As Boolean

  If Len(strFileName) = 0 Then
    ' Excel shall be closed.
    booTerminate = True
  End If

  If xlApp Is Nothing Then
    If booTerminate = False Then
      Set xlApp = New Excel.Application
    End If
  ElseIf booTerminate = True Then
    xlApp.Quit
    Set xlApp = Nothing
  End If

  If booTerminate = False Then
    Set xlWkb = xlApp.Workbooks.Open(FileName:=strFileName, UpdateLinks:=0, ReadOnly:=True)

    ' Make Excel visible (for troubleshooting only) or not.
    xlApp.Visible = False 'True

    For Each varMacro In avarMacros()
      If Not Len(varMacro) = 0 Then
  Debug.Print "xl run", Time, varMacro
        booSuccess = xlApp.Run(varMacro)
      End If
    Next varMacro
  Else
    booSuccess = True
  End If

  RunExcelMacros = booSuccess

Exit_RunExcelMacros:

  On Error Resume Next

  If booTerminate = False Then
    xlWkb.Close SaveChanges:=False
    Set xlWkb = Nothing
  End If

Debug.Print "xl end", Time
  Exit Function

Err_RunExcelMacros:
  Select Case Err
    Case 0      'insert Errors you wish to ignore here
      Resume Next
    Case Else   'All other errors will trap
      Beep
      MsgBox "Error: " & Err & ". " & Err.Description, vbCritical +
vbOKOnly, "Error, macro " & varMacro
      Resume Exit_RunExcelMacros
  End Select

End Function

Also, please note that you - as shown above - have to be extremely strict opening, using, and closing the Excel objects and in the correct order. No ActiveWorkbook or the like.

Answer 4

Base on Matt Hall's answer but altered to show how you can, from Access:

• Invoke an Excel module apart from ThisWorkbook ;
• Invoke Excel Subs or retrieve a value from an Excel Function; and
• Fetch the atlered values of parameters passed by reference.

In a custom module, named basTextModule , in Excel:

Public Sub ShowCoolMessage()
 MsgBox "cool"
End Sub

' Add02 is explictly ByRef (the default in VBA) to show that
' the parameter will be altered and have its value changed even for
' prodedures higher up the call stack.
Public Function GetCoolAmount(Add01 As Variant, _
                            Optional ByRef Add02 As Integer) As Integer
  Add02 = Add02 + 1
  GetCoolAmount = 10 + Add01 + Add02
End Function

In Access:

• Set a reference to Excel (VBA IDE > Tools > Reference ... Microsoft Excel 16.0 Object Library).
• Then create a (somewhat) generic RunExcelCode ...

For parameters passed by reference to work:

• Note from Microsoft Docs, Application.Run method (Excel) that when you pass parameters to the Excel Sub or Function "You cannot use named arguments with this method. Arguments must be passed by position".

• When declaring excelApp use Object rather than Excel.Application in order to ensure that the value of any parameters passed by reference to excelApp.Run can be retrieved. Source: Jaafar Tribak "Application.Run .. (Argument Passed ByRef)" at https://www.mrexcel.com/board/threads/application-run-argument-passed-byref.998132/post-4790961

• In the called sub or Function the parameters (apart from the first ModuleAndSubOrFunctionName ) must have a data type that match the datatype of the parmaters for the calling module or function. They can be variants or a specific datatype. Eg, and for illustrative purposes, Arg02 is an Integer and so must the second argument of GetCoolAmount when RunExcelCode(WorkbookPathAndFileName, "basTestModule.GetCoolAmount" ...) is used.

  However to make your RunExcelCode more generic it may be wise to ensure Arg01 , Arg02 , ... Arg30 paramters are all variants; and therefore the parameters of your ultimately called sub or function are also variants, for example ...

   Public Function GetCoolAmount(Add01 As Variant, _ Optional ByRef Add02 As Variant) As Integer ...

Public Function RunExcelCode(WorkbookPathAndFileName As String, _
                             ModuleAndSubOrFunctionName As String, _
                             Optional ByRef Arg01 As Variant, _
                             Optional ByRef Arg02 As Integer) As Variant
  ' Must be Object, not Excel.Application, to allow for parameters pass by reference
  Dim excelApp  As Object
  Dim workbook  As Excel.workbook
  
  Dim Result As Variant
  
On Error GoTo HandleErr
  
  ' Can be Excel.Application if excelApp previously declared as Object
  Set excelApp = New Excel.Application
  
'  excelApp.Visible = True ' For debugging
  
  Set workbook = excelApp.Workbooks.Open(WorkbookPathAndFileName)
  
  ' Get a value from a function or,
  ' if it is a sub a zero length string "" will be returned
  Result = excelApp.Run(ModuleAndSubOrFunctionName, Arg01, Arg02)
  
  RunExcelCode = Result

ExitHere:
  workbook.Close
  excelApp.Quit
  Set workbook = Nothing
  Set excelApp = Nothing
Exit Function

HandleErr:
  Select Case Err.number
    Case Else
      MsgBox "Error " & Err.number & ": " & Err.Description, _
        vbCritical, "RunExcelCode"
  End Select
  Resume ExitHere
End Function

Testing (from Access), calling a Sub and a Function:

Private Sub TestRunExcelCode()
  Dim WorkbookPathAndFileName  As String
  Dim Result As Variant
  
  WorkbookPathAndFileName = "C:\Users\YourName\Documents\MyWorkbook.xlsm"
  
  '   Run a sub
  Result = RunExcelCode(WorkbookPathAndFileName, "basTestModule.ShowCoolMessage")
  If IsNull(Result) Then
    Debug.Print "{Null}"
  ElseIf Result = "" Then
    Debug.Print "{Zero length string}"
  Else
    Debug.Print Result
  End If

  ' Will output "{Zero length string}"
  
  ' Get a value from a function
  Dim Arg02 As Integer
  Arg02 = 1
  Debug.Print "Arg02 Before: " & Arg02
  Result = RunExcelCode(WorkbookPathAndFileName, _
                      "basTestModule.GetCoolAmount", 1, Arg02)
  Debug.Print "Arg02 After : " & Arg02  ' Value will have changed, as desired.
  Debug.Print "Result      : " & Result
  
End Sub

Edit 01: Major change to make code more generic.

Edit 02: Major change to handle paramaters passed by reference.

Edit 03: Added details in the case "to make your RunExcelCode more generic".