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

我不是VB的人，但我被要求解决这个问题。我们有一个Access数据库，它将两个Access报告导出到Excel工作簿。它一直在工作多年。最近我们收到一条错误消息，说明Excel应用程序已打开并且必须关闭。数据库和Access模板都位于网络共享驱动器上。从我所看到的情况来看，我们并没有越过这一点。错误发生时服务器不显示Excel正在打开。我事先感谢您的帮助。请关闭Excel应用程序 - 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" 
    '==============================================================================

来源

2017-08-29 user3798811

你告诉Excel中运行时'ExcelWasNotRunning = TRUE;用户？ –

...你也应该取消'On Error Resume Next'，否则你的代码中的其他错误可能会被忽视。 –

您不应该将文件从**。xlsm **复制到**。xls **。你应该做一个SaveAs！许多钓鱼者使用这种技术来尝试绕过安全和诈骗人。当Set MyXL = GetObject（，“Excel.Application”）失败时，您还应该尝试'CreateObject（...）'。 – PatricK

我建议重新组织一下：

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

来源

2017-08-30 05:47:14

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

回答

相关问题