‘ret = Shell("C:\ExportSheetTxtFiles\DF.EXE C:\ExportSheetTxtFiles\t.txt C:\ExportSheetTxtFiles\t2.txt", 1)
Public Sub CompareFiles(ByVal filePath1 As String, ByVal filePath2 As String) Dim retVal Dim toolPath As String toolPath = "C:\ExportSheetTxtFiles\DF.EXE" Dim cmd As String cmd = toolPath & " " & filePath1 & " " & filePath2 Debug.Print cmd retVal = Shell(cmd, vbNormalFocus) End SubPublic 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 SubFunction 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 FunctionFunction 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 FunctionFunction 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 FunctionFunction 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 FunctionFunction 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
疯狂的博客
他们比任何人都分毫较量，又比任何人都口是心非。他们比任何人都依赖彼此，
