Excel VBA比較兩個工作簿將差異寫入文本文件

Question

經過語法上的艱苦努力之后，我可以使用以下代碼，但是我想使用錯誤檢查來確定文件是否已使用字符串打開。

（披露：我從源中復制了比較表，當我找到它時將鏈接它）

嘗試替換此代碼

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

但是我對字符串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