請關閉Excel應用程序 - Excel打開

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