如何把A盘中的所有*.txt文件读入数据库中?一个一个的好办，但是现在是很多个呀！

Question

some code copy from somebodySub scan(a As String)
Dim filename As String
Dim nd As Integer
Dim fold() As String
Dim n As Integerfilename = Dir(a, vbDirectory)
Do While filename <> ""
    If filename <> "." And filename <> ".." Then
        If GetAttr(a & filename) = vbDirectory Then
            nd = nd + 1
            ReDim Preserve fold(nd)
            fold(nd) = a & filename
           ' List2.AddItem (a & filename)
            TreeView1.Nodes.Add a, tvwChild, a & filename & "\", filename, 1, 2
        End If
    End If
    filename = Dir
    DoEvents
Loopfilename = Dir(a)
Do While filename <> ""
   ' List1.AddItem (a & filename)
    TreeView1.Nodes.Add a, tvwChild, a & filename, filename, 3, 4
    filename = Dir
LoopFor n = 1 To nd
   Call scan(fold(n) & "\")
Next    
End SubPrivate Sub Command1_Click()
TreeView1.ImageList = ImageList1
Dim vcmpath As String
'vcmpath = App.Path & "vvv\"
vcmpath = "c:\windows\"
TreeView1.Nodes.Add , , vcmpath, "VCM", 1, 2
Call scan(vcmpath)
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Text1.Text = Node.Key
End Sub

Answer 1

VB可以用DIR函数，我写一个例子可以列出所有A盘的TXT文件：
你看懂了以后，把strList部分去掉，换成你自己的处理函数，比
如funGetData(strFile)之类的（假设你用这个函数从strFile得
到数据文件名）SUB subFilelistDim strFile As String
'strList储存文件列表
Dim strList As String
strList = ""'注意DIR的用法，有参数时开始找文件
strFile = Dir("A:\*.txt")
Do While Len(strFile) > 0
   strList = strList & strFile & vbCrLf
   'DIR（）不带参数是继续查找，当没有匹配文件时返回空字串
   '因此上面用DO WHILE LEN（strFile)，等待strFile查完为止
   strFile = Dir()
Loop
MsgBox strListEND SUB

Answer 2

'手动选择导入的TXT文件
Private Sub Command3_Click()
     Dim f As New FileSystemObject
     Dim fd, fl, msg, s As String
     Dim n, i As Integer
     Dim a
     Const OFN_ALLOWMULTISELECT = &H200&
     Const cdlOFNExplorer = &H80000
     
     CommonDialog1.Flags = &H200
     CommonDialog1.InitDir = "a:\"
     CommonDialog1.Filter = "文本文件 *.txt|*.txt"
     CommonDialog1.filename = ""
     CommonDialog1.ShowOpen
     CommonDialog1.filename = CommonDialog1.filename & Chr(32)
   
     
     If CommonDialog1.filename = " " Then Exit Sub
      n = InStrRev(CommonDialog1.filename, "\")
     fd = Left(CommonDialog1.filename, n)
     fl = Right(CommonDialog1.filename, Len(CommonDialog1.filename) - n - 1)
     If f.FileExists("c:\temp.txt") Then
        f.DeleteFile ("c:\temp.txt")
     End If
     Set a = f.OpenTextFile("c:\temp.txt", ForAppending, True)
     While InStr(fl, Chr(32)) > 0
start:
       msg = msg & fd & Trim$(Left(fl, InStr(fl, Chr(32)))) & Chr(13) & Chr(10)
       a.WriteLine (fd & Trim$(Left(fl, InStr(fl, Chr(32)))))
       If f.FileExists(fd & Trim$(Left(fl, InStrRev(fl, Chr(32))))) Then GoTo line
line:
       fl = Right(fl, Len(fl) - InStr(fl, Chr(32)))
       If Not fl = "" Then GoTo start
     Wend
     rtb.Text = msg
     a.Close
     
End Sub'建立c:\temp.txt文件存储要用到的和TXT文件列表Private Sub Command2_Click()
    Dim f As New FileSystemObject
    If f.FileExists("c:\temp.txt") Then
      f.DeleteFile ("c:\temp.txt")
    End If
    End
   
End Sub
private function add() 
   Dim temStr, temStrO, strline, strlineO, filename, fristFile, ff
   Dim lineNum, i As Integer
   
   Set fs = CreateObject("Scripting.FileSystemObject")
   
   Set temp = fs.OpenTextFile("c:\temp.txt", ForReading, False)
   filename = temp.ReadLine()
   i = InStrRev(filename, "\")
  
   ff = Left(filename, i - 1)
   i = InStrRev(ff, "\")
   temStr = Left(filename, i)
   If Not i = 0 Then
       ff = Mid(ff, i)
   Else
       ff = "new"
    End If
   If Combo1.Text = ".txt" Then
       If Text1.Text = "" Then
          
          Set newF = fs.OpenTextFile(temStr & ff & ".htm", ForAppending, True)
       Else
          Set newF = fs.OpenTextFile(temStr & Text1.Text & ".txt", ForAppending, True)
       End If
   ElseIf Combo1.Text = ".htm" Then
        If Text1.Text = "" Then
          Set newF = fs.OpenTextFile(temStr & ff & ".htm", ForAppending, True)
       Else
          Set newF = fs.OpenTextFile(temStr & Text1.Text & ".htm", ForAppending, True)
       End If
       newF.WriteLine ("<html><head><title>" & Text1.Text & "</title></head><body  bgcolor='fff0f8'><font color='#800000'>")
   End If
   temStr = filename
   fristFile = filename
   Do While Not temStr = temStrO
     
      Set oldF = fs.OpenTextFile(temStr, ForReading, False)
      strline = Trim$(oldF.ReadLine)
         Do While strline <> strlineO
         Dim s, b, f, find
nowstart:
          f = InStr(strline, "<body")
         b = InStr(strline, "</body>")
         '查找"<body>"
         If f <> 0 Then
              find = True
         ElseIf find <> True Then
              GoTo nextline
         End If
         If b <> 0 Then
            find = False
            GoTo myexit
         End If
         '判断文体区
         If find = True Then
            s = del(strline)
            If s = "" Then GoTo nextline
           End If
         
nextline:
            strlineO = strline
mystart:
            If oldF.AtEndOfStream <> True Then               strline = oldF.ReadLine
               If strline = "" Then GoTo mystart
            End If
         Loop
myexit:
           temStrO = temStr
         
         If temp.AtEndOfStream <> True Then
            temStr = temp.ReadLine
            If temStr = fristFile Then GoTo stopit
         
         End If
      oldF.Close
      Loop
stopit:
      newF.Close
      temp.Close
end function
其中FUNCTION 中你要改为数据库添加数据，这是我一个文件合并器的代码
临时变量很多，保存新旧文件名，所取数据位置，数据是否可用等等，作用未完全说明