经过多次语法攻击后,我有以下代码工作,但我想使用错误检查来确定文件是否已使用字符串打开。
(披露:我已经复制了来自我将在发现时链接的来源的比较表)
尝试替换此代码
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
答案 0 :(得分: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
答案 1 :(得分:0)
这将检查您是否打开文件。
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
错误的一个原因可能是包含&#34; FileName:=&#34;在Workbooks.Open中。尝试;
Set wbkA = Workbooks.Open(wba)
Set wbkB = Workbooks.Open(wbb)
答案 2 :(得分:0)
修正了我的代码,并为了清晰起见而重新发布了更正。 注意我移动到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