如何將文本文件导入 Access ？(一) [转帖]

duzili

看到有很多网友提及这个问题,有好东西不敢独享,贴出来大家参考参考.

来源: http://www.vbguide.com.tw/ 之各个击破 问题273

原文如下：（有删节）
==================================================================
主題：如何將文字檔轉入 Access 資料庫？(一)
來源：王國榮原著，Spencer Yang 改寫
版本：VB6

--------------------------------------------------------------------------------


參考資料：王國榮編著之《Visual Basic 6.0 程式設計》附錄B <我如何收集120,000筆的資料>

前言



以後，將逐一介紹下列主題：

1[B]、有分隔符號的文字檔轉入資料庫；
2、固定長度的文字檔，但文字檔之中的有困擾程式設計師的中文字；
3、固定長度的文字檔，文字檔也有中文字，但是使用物件類別 (Class)來處理。[/B]
程式碼如下：

Private objConn As ADODB.Connection
Private objRec As ADODB.Recordset
Private Sub Command1_Click()
    Dim strConnectionString As String
    Dim strFileName As String

    strConnectionString = "rovider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
                                     & App.Path & "\Stock.mdb"

    '如果超過一個 *.txt 檔案存在電腦裏，也可以傳入指定的副檔名
    '加以搜尋。函數將傳回第一個找到符合條件的檔案名稱。
    strFileName = Dir(App.Path & "\*.txt")

    '開啟ADODB 物件。
    Set objConn = New ADODB.Connection
    objConn.Open strConnectionString
    Set objRec = New ADODB.Recordset
    objRec.Open "歷史行情表", objConn, adOpenKeyset, adLockPessimistic

    '循序讀入文字檔，如0002.TXT、0003.TXT,...。
    While strFileName <> ""
        '開啟文字檔。
        Open App.Path & "\" & strFileName For Input As #1
        '將文字檔資料轉入資料庫。
        PutToData1 strFileName, objRec
        '關閉文字檔。
        Close #1
        'ListBox 加入檔名。
        List1.AddItem strFileName
        '暫停執行，以便讓作業系統可以處理其它的事件。
        DoEvents
        '若再呼叫此函數，但不傳入任何引數，則函數將傳回和第一個
        '找到的檔案相同目錄下第二個找到的 *.TXT 檔案。
        strFileName = Dir
    Wend

    ' 關閉ADODB 物件。
    objRec.Close
    objConn.Close
    Set objRec = Nothing
    Set objConn = Nothing
End Sub
Private Sub PutToData1(ByVal strFileName As String, objRec As ADODB.Recordset)
    Dim strX As String                    '有含換行字元字串變數
    Dim strY As String                   '不含換行字串字串變數
    Dim intPosition As Integer       '計算位置變數
    Dim intPlus As Integer             '正負號變數
        
    '從一個已開啟的循序檔中讀入一行資料，並將它指定給一個String變數.。
    Line Input #1, strX
    '找尋換行字元 vbLf=Chr(10)
    intPosition = InStr(strX, vbLf)
    '處理標題列。
    If intPosition > 0 Then
        strY = Left(strX, intPosition - 1)
        strX = Mid(strX, intPosition + 1)
    Else
        strX = ""
    End If
         
    '處理資料列。
    While Len(strX) > 0
        intPosition = InStr(strX, vbLf)
        If intPosition > 0 Then
            strY = Left(strX, intPosition - 1)
            strX = Mid(strX, intPosition + 1)
        Else
            strY = strX
            strX = ""
        End If
        
        '寫入歷史行情表資料表。
        With objRec
            .AddNew
            !股票代號 = Left(strFileName, 4)
            !日期 = (Val(Left(strY, 2)) + 11) & Mid(strY, 3, 6)
            !成交量 = Val(Mid(strY, 10, 8))
            !收盤價 = CCur(Mid(strY, 49, 6))
            !最高價 = CCur(Mid(strY, 35, 6))
            !最低價 = CCur(Mid(strY, 42, 6))
            '判斷漲跌符號，假如有▼者，表示為負數，數字前面要加 - 符號。
            intPosition = InStr(strY, "▼")
            intPlus = 1
            If intPosition > 0 Then intPlus = -1
            !漲跌 = Val(Mid(strY, 58, 6)) * intPlus
            .Update
        End With
    Wend
End Sub
下載範例程式碼
http://www.vbguide.com.tw/howto/300/data/impdb1.zip

[此贴子已经被作者于2003-12-21 19:16:28编辑过]