Excel VBAで2つのワークブックをテキストファイルと比較する比較

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 

エラーの1つの理由は、「FileName：=」をWorkbooks.Openに含めることができます。試してみる。

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