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
 

分享题目:VBA文件比较代码
URL网址:http://scyanting.com/article/gpjigh.html