代码如下：
'通过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