Question

我不是VB人员，但我被要求解决此问题。我们有一个Access数据库，它将两个Access报告导出到Excel工作簿。它已经工作多年了。最近我们收到一条错误消息，表明Excel应用程序已打开，必须关闭。数据库和Access模板都位于网络共享驱动器上。从我所看到的，我们没有超越这一点。服务器不会将Excel显示为在发生错误时打开。我提前感谢您的帮助。

这是我的代码：

Private Sub ExportCounts_Excel()
Dim excelname As String
Dim AppExcel As New Excel.Application
Dim Wkb As Workbook
Dim Wksh As Worksheet
Dim Wksh1 As Worksheet
Dim Wksh2 As Worksheet
Dim obj As AccessObject
Dim dbs As Object
Dim rs As Object
Dim rstable As Object

Dim tempTable As String
Dim data As String
Dim Agent As String
Dim Name As String
Dim newfile As String
Dim tic As String
Dim lastrow As Long
Dim count As Integer
Dim recount As Integer

On Error GoTo Errorcatch
DoCmd.SetWarnings False

  '*****************************************************************************

Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Call fso.CopyFile("\\cfbf-sql\mbdb\Counts Reports Template.xlsm", "\\cfbf-sql\itdb\IT-Test DBs\counts\Counts Reports.xls")


  'see if the excel app is running
  Dim MyXL As Object                'Variable to hold reference
  Dim ExcelWasNotRunning As Boolean 'Flag for final release
  On Error Resume Next

  Set MyXL = GetObject(, "Excel.Application")

  If Err.Number <> 0 Then
    ExcelWasNotRunning = True
  End If

  'Check if the Excel Application is running
   If ExcelWasNotRunning = True Then
    'If Excel is running then.............
    MsgBox "Please Close your Excel Application" & vbCrLf _
            & "and save your files before attempting" & vbCrLf _
            & "to run the report", vbInformation, _
            "Microsoft Excel is open"

      Set MyXL = Nothing
    Exit Sub

  Else 'Excel is not running

    'Optional - to storage the file name entered by user
    Dim Message, Title, Default, MyValue
    Message = "Enter a name for the file"  ' Set prompt.
    Title = "Assign File Name"    ' Set title.

    'Format date to use it as file name and report title
    Dim varMonthNum As Variant
    Dim varDayNum As Variant
    Dim varYear As Variant
    Dim varFileDate As Variant

    'Get the month, day, and year from LastFriday text box
    varMonthNum = Month(LastFriday.Value)
    varDayNum = Day(LastFriday.Value)
    varYear = Year(LastFriday.Value)

    'Format the date to assign it as part of the file name
    varFileDate = varMonthNum & "-" & varDayNum & "-" & varYear

    'use the following variable to format the file name
    Default = Me.CurrentYear.Value & " CFBF Membership Report as of " & varFileDate    ' Set default.

    ' Display message, title, and default value.
    MyValue = InputBox(Message, Title, Default)

    If StrPtr(MyValue) = 0 Then 'IF the vbCancel Button is selected by the user
      'Exit the procedure
      Exit Sub
    Else 'Create the excel report

    '*****************************************************************************
    'excelname = "\\member2\MBDB\Counts Reports Template.xls"
    excelname = "\\cfbf-sql\MBDB\Counts Reports Template.xls"


    'For the new fiscal year 2014
    'newfile = "\\web3\FBMNData\WEEKLY COUNTY REPORTS 2011\" & MyValue & ".xls"
    'newfile = "\\web3\FBMNData\WEEKLY COUNTY REPORTS 2013\" & MyValue & ".xls"
    'newfile = "\\web3\FBMNData\WEEKLY COUNTY REPORTS 2014\" & MyValue & ".xls"
    'newfile = "\\web3\FBMNData\WEEKLY COUNTY REPORTS 2015\" & MyValue & ".xls"
    '==============================================================================
    '****       Comments by: Armando Carrasco - 11/21/2014                      ***
    '**** MMR - Kate Tscharner - requested to stop posting excel file in        ***
    '**** the counties FTP site and to place the file in the everyone folder    ***
    '**** MMR also requested to move all "WEEKLY COUNTY REPORTS YYYY" folders   ***
    '**** from WEB3 to  "\\cfbf-fp\Everyone\MembershipReports\"                 ***
    'newfile = "\\cfbf-fp\Everyone\MembershipReports\WEEKLY COUNTY REPORTS 2015\" & MyValue & ".xls"
    '==============================================================================
    '****       Comments by: Armando Carrasco - 01/21/2014                      ***
    '**** MMR - Kate Tscharner - WO 1284 - Comments                             ***
    '**** We have had the request from several county Farm Bureaus to restore   ***
    '**** Placing the old network directory location in WEB3.                   ***
    newfile = "\\cfbf-reports\FBMNData\WEEKLY COUNTY REPORTS 2017\" & MyValue & ".xls"
    '==============================================================================

Answer 1

我建议重新组织一下：

  Dim MyXL As Object                'Variable to hold reference
  Dim ExcelWasRunning As Boolean    'Flag for final release

  On Error Resume Next   '<< ignore error if Excel not running
  Set MyXL = GetObject(, "Excel.Application")
  On Error Goto 0        '<< cancel the On Error Resume Next so you
                         '    don't miss later (unexpected) issues

  ExcelWasRunning = Not MyXL Is Nothing '<< If Excel was running then MyXL
                                        '     is set to the Excel instance
  If ExcelWasRunning  Then

        MsgBox "Please Close your Excel Application" & vbCrLf _
                & "and save your files before attempting" & vbCrLf _
                & "to run the report", vbInformation, _
                "Microsoft Excel is open"

        Set MyXL = Nothing

        Exit Sub '<< Shouldn't really need this, since the rest of your code
                 '   is in the Else block...
  Else 

      'Excel is not running
      'Rest of your code here

  End If

请关闭Excel应用程序 - Excel已打开

1 个答案: