VBA文件比较代码
'ret = Shell("C:\ExportSheetTxtFiles\DF.EXE C:\ExportSheetTxtFiles\t.txt C:\ExportSheetTxtFiles\t2.txt", 1)
Public Sub CompareFiles(ByVal filePath2 As String, ByVal filePath3 As String)
Dim retVal
Dim toolPath As String
toolPath = "C:\ExportSheetTxtFiles\DF.EXE"
Dim cmd As String
cmd = toolPath & " " & filePath2 & " " & filePath3
Debug.Print cmd
retVal = Shell(cmd, vbNormalFocus)
End Sub
Public Sub SheetsCompare()
Dim ws As Worksheet
Dim wb As Workbook
Dim ws2 As Worksheet
For Each wb In Workbooks
If wb.Name <> ActiveWorkbook.Name Then
For Each ws In wb.Worksheets
If ws.Name = ActiveSheet.Name Then
Set ws2 = ws
Exit For
End If
Next
End If
Next
If ws2 Is Nothing Then
MsgBox "The Compared sheet is not exist."
Exit Sub
End If
Dim fn1 As String, fn2 As String
fn1 = DoMyExportTxt(ActiveSheet, "Main")
fn2 = DoMyExportTxt(ws2, "Compared")
Call CompareFiles(fn1, fn2)
End Sub
Function GetRowData(row As Range)
Dim cell As Range
Dim retVal As String
retVal = ""
Dim count, colCount1 As Integer
count = 0
colCount1 = row.Worksheet.Range("IV" & row.row).End(xlToLeft).Column
For Each cell In row.Cells
If count >= colCount1 Then Exit For
If cell.value = "" Then
retVal = retVal & " "
Else
retVal = retVal & cell.value
End If
count = count + 1
Next
GetRowData = retVal
End Function
Function MaxRowIndex(ws As Worksheet)
Dim i, index, tempIndex As Integer
index = 0
For i = 1 To 100
tempIndex = ws.Cells(65536, i).End(xlUp).row
If tempIndex > index Then index = tempIndex
Next
MaxRowIndex = index
End Function
Function DoMyExportTxt(ws As Worksheet, ByVal fn As String) As String
Dim lastRow, count As Integer
lastRow = MaxRowIndex(ws)
count = 0
Dim row As Range
Dim txt, txtRow, fileName As String
txt = ""
txtRow = ""
For Each row In Rows
If count > lastRow Then Exit For
txtRow = GetRowData(row)
txt = txt & txtRow & vbCrLf
count = count + 1
Next
txt = Strings.Left(txt, Len(txt) - 2)
'fileName = ws.Parent.Name & "_" & ws.Name & "_" & ReplaceAll(DateTime.Time, ":", "-") & ".txt"
fileName = fn
If MakeTxtFile(txt, fileName) Then
'MsgBox "Export txt file success!" & vbCrLf & vbCrLf & "FileName: yC:\ExportSheetTxtFiles\" & fileName & "z"
End If
DoMyExportTxt = "C:\ExportSheetTxtFiles\" & fileName
End Function
Function ReplaceAll(str As String, src As String, dest As String)
Dim index As Integer
index = Strings.InStr(1, str, src)
While index > 0
str = Strings.Replace(str, src, dest)
index = Strings.InStr(1, str, src)
Wend
ReplaceAll = str
End Function
Function MakeTxtFile(ByVal txt As String, ByVal fileName As String)
'On Error GoTo msgLabel
Dim MyFile As Object
If Not IsFileExist("C:\ExportSheetTxtFiles\") Then
MkDir "C:\ExportSheetTxtFiles\"
End If
Dim filePath As String
filePath = "C:\ExportSheetTxtFiles\" & fileName
Open filePath For Output As #1
Print #1, txt
Close #1
Reset
MakeTxtFile = True
Exit Function
msgLabel:
MsgBox "Make file failed! Maybe the file has bean opened!"
MakeTxtFile = False
End Function
