简体   繁体   中英

Excel VBA compare two workbooks write difference to text file

After much struggle with syntax, I have following code working, but I want to use error checking to determine if file is already open using a string.

(Disclosure: I have copied comparesheets from source that I will link when I find it)

Trying to replace this code

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

with

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

But I have syntax problem with the string wba. What is proper way use string here?

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

You can use On Error Resume Next to ignore any error:

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

This will check to see if you have the file open.

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

If you dont have it open, check to see if someone else does.

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

And one reason for your error could be the inclusion of "FileName:=" in the Workbooks.Open. Try;

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

Fixed my code and reposting with corrections for clarity. Note I moved to C:\\temp since writing to root C:\\ folder should not be used because many work computers have root folder locked for security as my colleague just found out!

  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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM