使用 MS Access 在 excel vba 中運行代碼

Question

我使用訪問前端從 SQL Server 中提取查詢。 然后我將記錄集導出到一個新的 Excel 工作簿。 然后我想使用 excel 來運行我在 Access 中的代碼。 它只是遍歷單元格並添加格式並檢查某個值。 我可以從訪問中運行它，它將讓工作簿打開循環。 然而，它是痛苦的緩慢。

如果我進入excel並粘貼訪問正在運行的代碼以進行格式化並檢查。 它在幾秒鍾內運行。 但是從 access 運行它需要 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 ），也在這里檢查
• 停止重新計算工作表 - 檢查這個
• 在 Excel 工作表中編寫相同的函數（作為模板文件），並且只能從 Access 中運行它

我希望這有幫助。

通常，自動化比宏（vba 代碼）慢得多。 這同樣適用於其他應用程序，例如。 微軟字。

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 ...

對於通過引用傳遞的參數工作：

• 請注意Microsoft Docs 中的 Application.Run 方法 (Excel) ，當您將參數傳遞給 Excel Sub 或函數時，“您不能在此方法中使用命名參數。參數必須按位置傳遞”。

• 聲明excelApp 時使用Object而不是Excel.Application以確保可以檢索通過引用傳遞給 excelApp.Run 的任何參數的值。 資料來源：Jaafar Tribak“Application.Run ..（Argument Passed ByRef）”在https://www.mrexcel.com/board/threads/application-run-argument-passed-byref.998132/post-4790961

• 在被調用的 sub 或 Function 中，參數（除了第一個ModuleAndSubOrFunctionName ）必須具有與調用模塊或函數的參數的數據類型匹配的數據類型。 它們可以是變體或特定的數據類型。 例如，出於說明目的， Arg02是一個整數，因此在使用RunExcelCode(WorkbookPathAndFileName, "basTestModule.GetCoolAmount" ...)時必須是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 更通用”的情況下添加了詳細信息。