用VB Scritp如何检查一个Excel文件是否已经打开，并closures它，而不保存它。

我有以下代码。 它从一个工作簿复制工作表到另一个工作簿。 如果两个文件都closures，它工作正常。 我想修改这段代码，首先检查两个文件是否都打开，closures它们而不保存任何修改，最后执行和我现在一样的操作。

' Create Excel object Set objExcel = CreateObject("Excel.Application") ' Open the source workbook Set SOURCE = objExcel.Workbooks.Open("Path\Source.xls") ' Open the destination workbook Set DEST = objExcel.Workbooks.Open("C:Path\Destination.xlsx") objExcel.Visible = False ' Select the range on source Sheet1 you want to copy SOURCE.Worksheets("Sheet1").Range("A1:AZ2500").Copy ' Paste it on Destiny Sheet1, starting at A1 DEST.Worksheets("Sheet").Range("A1").PasteSpecial ' Save and close workbooks DEST.save DEST.close SOURCE.close 

Answer 1

下面的代码将检查Excel是否打开，如果是，请检查您的源工作簿和目标工作簿，如果打开，请closures它们而不保存它们。 之后，它将打开文件，并将目标中的范围设置为Source中的范围。

由于代码纯粹是每次都设置相同的范围，所以我不禁想到只要打开Source工作簿，然后将其保存为目标并覆盖现有的目标文件即可。

让我知道你是否需要进一步解释这是如何工作的。

 Option Explicit Dim oExcel, oWorkbook ' Check if Excel is open On Error Resume Next Set oExcel = GetObject(, "Excel.Application") ' If Excel is open this will set a reference to it On Error Goto 0 If Not IsObject(oExcel) Then ' Excel wasn't running, create an instance Set oExcel = CreateObject("Excel.Application") End If ' Check any open workbooks in the Excel instance If oExcel.Workbooks.Count > 0 Then For Each oWorkbook In oExcel.Workbooks If oWorkbook.Path = "Path\Source.xls" Or oWorkbook.Path = "Path\Destination.xlsx" Then oWorkbook.Close True ' closes workbook without saving changes End If Next End If ' Open the source workbook Set SOURCE = oExcel.Workbooks.Open("Path\Source.xls") ' Open the destination workbook Set DEST = oExcel.Workbooks.Open("Path\Destination.xlsx") oExcel.Visible = False ' Set the destination range to the source range DEST.Worksheets("Sheet").Range("A1:AZ2500") = SOURCE.Worksheets("Sheet1").Range("A1:AZ2500") ' Save and close workbooks DEST.Save DEST.Close SOURCE.Close Set oExcel = Nothing ' drop the reference to excel object