Excel VBA比较两个工作簿将差异写入文本文件

经过很多与语法斗争，我有以下代码工作，但我想使用错误检查，以确定文件是否已经打开使用string。

（披露：我已经复制了来源的比较表，当我find它的时候我会链接）

试图replace这个代码

Set wbkA = Workbooks.Open(FileName:=wba) 

同

 Set wBook = Workbooks(wba) 'run time error subscript out of range If wBook Is Nothing Then Set wbkA = Workbooks.Open(FileName:=wba) End If 

但是我有stringwba的语法问题。 什么是正确的方式使用string？

 Sub RunCompare_WS2() Dim i As Integer Dim wba, wbb As String Dim FileName As Variant Dim wkbA As Workbook Dim wkbB As Workbook Dim wBook As Workbook wba = "C:\c.xlsm" wbb = "C:\d.xlsm" 'Set wBook = Workbooks(FileName:=wba) 'compiler error named argument not found 'Set wBook = Workbooks(wba) 'run time error subscript out of range 'If wBook Is Nothing Then 'Set wbkA = Workbooks.Open(FileName:=wba) 'End If Set wbkA = Workbooks.Open(FileName:=wba) Set wbkB = Workbooks.Open(FileName:=wbb) For i = 1 To Application.Sheets.Count Call compareSheets(wbkA.Sheets(i), wbkB.Sheets(i)) Next i wbkA.Close SaveChanges:=True wbkB.Close SaveChanges:=False MsgBox "Completed...", vbInformation End Sub Sub compareSheets(shtSheet1 As Worksheet, shtSheet2 As Worksheet) Dim mycell As Range Dim mydiffs As Integer Dim DifFound As Boolean DifFound = False sDestFile = "C:\comp-wb.txt" DestFileNum = FreeFile() Open sDestFile For Append As DestFileNum 'For each cell in sheet2 that is not the same in Sheet1, color it lightgreen in first file For Each mycell In shtSheet1.UsedRange If Not mycell.Value = shtSheet2.Cells(mycell.Row, mycell.Column).Value Then If DifFound = False Then Print #DestFileNum, "Row,Col" & vbTab & vbTab & "A Value" & vbTab & vbTab & "B Value" DifFound = True End If mycell.Interior.Color = 5296274 'LightGreen Print #DestFileNum, mycell.Row & "," & mycell.Column, mycell.Value, shtSheet2.Cells(mycell.Row, mycell.Column).Value '& vbInformation mydiffs = mydiffs + 1 End If Next Print #DestFileNum, mydiffs & " differences found in " & shtSheet1.Name Close #DestFileNum End Sub 

Answer 1

您可以使用On Error Resume Next忽略任何错误：

 Const d As String = "C:\" wba = "c.xlsm" On Error Resume Next Set wBook = Workbooks(wba) On Error Goto 0 If wBook Is Nothing Then Set wbkA = Workbooks.Open(d & wba) 'join string d & wba End If 

Answer 2

这将检查是否打开文件。

 Option Explicit Function InputOpenChecker(InputFilePath) As Boolean Dim WB As Workbook Dim StrFileName As String Dim GetFileName As String Dim IsFileOpen As Boolean InputOpenChecker = False 'Set Full path and name of file to check if already opened. GetFileName = Dir(InputFilePath) StrFileName = InputFilePath & GetFileName IsFileOpen = False For Each WB In Application.Workbooks If WB.Name = GetFileName Then IsFileOpen = True Exit For End If Next WB 

如果你没有打开，请检查是否有其他人。

 On Error Resume Next ' If the file is already opened by another process, ' and the specified type of access is not allowed, ' the Open operation fails and an error occurs. Open StrFileName For Binary Access Read Write Lock Read Write As #1 Close #1 ' If an error occurs, the document is currently open. If Err.Number <> 0 Then 'Set the FileLocked Boolean value to true FileLocked = True Err.Clear End If 

而您的错误的一个原因可能是在Workbooks.Open中包含“FileName：=”。 尝试;

  Set wbkA = Workbooks.Open(wba) Set wbkB = Workbooks.Open(wbb) 

Answer 3

修正了我的代码，并为了清晰而重新发布更正。 注意我移到C：\ temp，因为写入到根目录C：\文件夹不应该被使用，因为许多工作计算机的根文件夹被locking为安全，就像我的同事刚刚发现的那样！

  Sub RunCompare_WS9() 'compare two WKbooks, all sheets write diff to text file Dim i As Integer Dim wba, wbb As String Dim FileName As Variant Dim wkbA As Workbook Dim wkbB As Workbook Dim wbook1 As Workbook Dim wbook2 As Workbook wba = "C:\test\c.xlsm" wbb = "C:\test\d.xlsm" On Error Resume Next Set wbook1 = Workbooks(wba) On Error GoTo 0 If wbook1 Is Nothing Then Set wbkA = Workbooks.Open(wba) End If On Error Resume Next Set wbook2 = Workbooks(wbb) On Error GoTo 0 If wbook2 Is Nothing Then Set wbkB = Workbooks.Open(wbb) End If For i = 1 To Application.Sheets.Count Call compareSheets(wbkA.Sheets(i), wbkB.Sheets(i)) Next i wbkA.Close SaveChanges:=True wbkB.Close SaveChanges:=False MsgBox "Completed...", vbInformation End Sub Sub compareSheets(shtSheet1 As Worksheet, shtSheet2 As Worksheet) Dim mycell As Range Dim mydiffs As Integer Dim DifFound As Boolean DifFound = False sDestFile = "C:\Test\comp2-wb.txt" DestFileNum = FreeFile() Open sDestFile For Append As DestFileNum 'For each cell in sheet2 that is not the same in Sheet1, color it lightgreen in first file For Each mycell In shtSheet1.UsedRange If Not mycell.Value = shtSheet2.Cells(mycell.Row, mycell.Column).Value Then If DifFound = False Then Print #DestFileNum, "Row,Col" & vbTab & vbTab & "A Value" & vbTab & vbTab & "B Value" DifFound = True End If mycell.Interior.Color = 5296274 'LightGreen Print #DestFileNum, mycell.Row & "," & mycell.Column, mycell.Value, shtSheet2.Cells(mycell.Row, mycell.Column).Value '& vbInformation mydiffs = mydiffs + 1 End If Next Print #DestFileNum, mydiffs & " differences found in " & shtSheet1.Name Close #DestFileNum End Sub