Question

我使用访问前端从SQL Server中提取查询。然后，我将记录集导出到新的Excel工作簿。我想然后使用excel来运行我在Access中的代码。它只是循环遍历单元格并添加格式并检查特定值。我可以从访问中运行它，它将工作簿打开循环很好。但是它很慢。

如果我进入excel并粘贴正在运行访问的代码以进行格式化并检查。它在几秒钟内运行。但是从访问中运行它需要10多分钟。

如果能做到这一点，任何人都有任何想法？

Answer 1

我已将此代码放在Excel中的“ThisWorkbook”对象中：

Public Sub TestScript()

    Debug.Print "Hello"

End Sub

然后使用表单上的按钮从Access成功调用它：

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

不可否认，我没有给它运行很多代码，但这里的代码至少在Excel上运行，从Excel ...这必须比尝试运行代码更好来自Access的Excel。

更新：看看你是否可以通过测试来创建Access到Excel的模块（我无法正确测试它，因为我正在使用工作计算机而且似乎没有让我由于安全设置而运行此类代码）

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

如果我理解正确，您将代码从Access复制到Excel并在Excel中运行相同的代码，在这两种情况下，代码都会操纵电子表格，Excel中的代码很快，而另一个在Access中很慢，您可以尝试以下方法：

隐藏Excel窗口（ActiveWorkbook.Windows(1).Visible = False），同时选中here
停止重新计算工作表 - 请检查this
在Excel工作表（作为模板文件）中编写相同的函数，并仅从Access

我希望这会有所帮助。

通常，自动化比宏（vba代码）慢得多。这同样适用于其他应用，例如。 MS Word。

Answer 3

如果您希望在Excel中运行的代码始终相同，则打开一个Excel模板，其中附带一个宏工作簿，并保存您的代码。然后，从Access，您可以运行一系列宏，当然，如果只有一个宏传递给参数数组，则只能运行一个宏：

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

另外，请注意，您 - 如上所示 - 必须非常严格地打开，使用和关闭Excel对象并按正确的顺序。没有ActiveWorkbook等。

Answer 4

基于 Matt Hall 的回答，但已更改以展示您如何从 Access 中：

调用除 ThisWorkbook 之外的 Excel 模块；
调用 Excel Subs 或从 Excel 函数中检索值；和
获取通过引用传递的参数的atlered值。

在 Excel 中名为 basTextModule 的自定义模块中：

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

访问中：

设置对 Excel 的引用（VBA IDE > 工具 > 引用 ... Microsoft Excel 16.0 对象库）。
然后创建一个（有点）通用的 RunExcelCode ...

对于通过引用传递给work的参数：

请注意 Microsoft Docs, Application.Run method (Excel)，当您将参数传递给 Excel Sub 或函数时“您不能在此方法中使用命名参数。参数必须按位置传递”。
当声明 excelApp 使用 Object 而不是 Excel.Application 以确保可以检索通过引用传递给 excelApp.Run 的任何参数的值。资料来源：https://www.mrexcel.com/board/threads/application-run-argument-passed-byref.998132/post-4790961
的 Jaafar Tribak“Application.Run ..（Argument Passed ByRef）”
在被调用的 sub 或 Function 中，参数（除了第一个 ModuleAndSubOrFunctionName 之外）的数据类型必须与调用模块或函数的参数的数据类型相匹配。它们可以是变体或特定的数据类型。例如，为了便于说明，Arg02 是一个整数，因此当使用 GetCoolAmount 时 RunExcelCode(WorkbookPathAndFileName, "basTestModule.GetCoolAmount" ...) 的第二个参数必须如此。

然而，为了使您的 RunExcelCode 更通用，最好确保 Arg01、Arg02、... Arg30 参数都是变体；因此，您最终调用的 sub 或 function 的参数也是变体，例如 ...
```
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

测试（来自 Access），调用一个 Sub 和一个函数：

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

编辑 01：主要更改以使代码更通用。

编辑 02：处理通过引用传递的参数的重大更改。

编辑 03：在“使您的 RunExcelCode 更通用”的案例中添加了详细信息。

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

4 个答案: