Private objConn As ADODB.Connection
Private objRec As ADODB.Recordset
Private Sub Command1_Click()
Dim strConnectionString As String
Dim strFileName As String
'開啟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