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

Question

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

（披露：我已经复制从源comparesheets当我找到它，我将链接）

试图与

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) 

但是我有语法问题与字符串wba。这里使用字符串的正确方法是什么？

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：\的文件夹，因为我的同事刚刚发现了很多工作计算机都有根文件夹锁定，以确保安全！

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