VB 源码 删除重复行程序 函数

代码如下：

'通过VB脚本改写而成，可以直接使用  放入程序中可以直接使用

'删除重复行程序 '

'foutPathName  为待删除的文本文件。注：输入文件不能有空行，别外扩展名必需为.TXT

'Fout   为输出的文本文件
Private Function DelSameLine(foutPathName As String, Fout As String) As Boolean   'foutPathName="c:\miaozk.txt"
    ' On Error GoTo errDel
    DelSameLine = True

    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordset = CreateObject("ADODB.Recordset")

    strPathtoTextFile = GetFilePath(foutPathName)
    strFile = GetFileName(foutPathName)

    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                       "Data Source=" & strPathtoTextFile & ";" & _
                       "Extended Properties=""text;HDR=NO;FMT=Delimited"""

    objRecordset.Open "Select DISTINCT * FROM " & strFile, _
                      objConnection, adOpenStatic, adLockOptimistic, adCmdText

    Do Until objRecordset.EOF

        Set objFso = CreateObject("Scripting.FileSystemObject")
        Set fp = objFso.OpenTextFile(Fout, 8, True, 0)
        fp.WriteLine objRecordset.Fields.Item(0).Value
        fp.Close
        Set objFso = Nothing
        objRecordset.MoveNext
    Loop
    Exit Function
errDel:
    DelSameLine = False
End Function

'路径名如：c:\miaozk2006.txt
'获取文件名
Public Function GetFileName(FilePathFileName As String) As String  '获取 miaozk2006.txt

    On Error Resume Next
    Dim i As Integer, J As Integer
    i = Len(FilePathFileName)
    J = InStrRev(FilePathFileName, "\")
    GetFileName = Mid$(FilePathFileName, J + 1, i)
End Function
'获取文件路径
Public Function GetFilePath(FilePathFileName As String) As String '获取   c:\
    On Error Resume Next
    Dim J As Integer
    J = InStrRev(FilePathFileName, "\")
    GetFilePath = Mid$(FilePathFileName, 1, J)
End Function

摘自：网络整理

---

相关文章参考：

---

★VB查找替代字符串的函数

★VB换行气泡提示类

★VB/VBA通用路径选择对话框

★ASCII码表0-255完整版 附详细注释

★VB的KeyAscii

★</