miaozk2006

'ͨ¹ý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