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