VB2008测试通过 Imports System Imports System.IO Imports System.Threading Imports System.Windows.Forms\x0d\x0a Public Class FrmMain\x0d\x0a\x0d\x0aDim newSearcher As getFileByName\x0d\x0a\x0d\x0a Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load\x0d\x0a\x0d\x0arball.Checked = True\x0d\x0a\x0d\x0atbpath.Text = ""\x0d\x0a\x0d\x0atbpath.Enabled = False\x0d\x0a\x0d\x0abtndlg.Enabled = False\x0d\x0a\x0d\x0aEnd Sub\x0d\x0a\x0d\x0a Private Sub btnOK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOK.Click\x0d\x0a\x0d\x0atv.Nodes.Clear()\x0d\x0a\x0d\x0abtnOK.Enabled = False\x0d\x0a\x0d\x0abtnExit.Enabled = False\x0d\x0a\x0d\x0aIf rball.Checked Then\x0d\x0a\x0d\x0arun()\x0d\x0a\x0d\x0aElse\x0d\x0a\x0d\x0aIf tbpath.Text = "" Then\x0d\x0a\x0d\x0aMsgBox("
请输入或者选择一个
路径")\x0d\x0a\x0d\x0aExit Sub\x0d\x0a\x0d\x0aElse\x0d\x0a\x0d\x0arun(tbpath.Text)\x0d\x0a\x0d\x0aEnd If\x0d\x0a\x0d\x0aEnd If\x0d\x0a\x0d\x0aEnd Sub\x0d\x0a\x0d\x0a Private Sub btndlg_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btndlg.Click\x0d\x0a\x0d\x0afbdlg.RootFolder = Environment.SpecialFolder.MyComputer\x0d\x0a\x0d\x0afbdlg.ShowDialog()\x0d\x0a\x0d\x0atbpath.Text = fbdlg.SelectedPath\x0d\x0a\x0d\x0aEnd Sub\x0d\x0a\x0d\x0a Private Sub rbchs_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbchs.CheckedChanged\x0d\x0a\x0d\x0aIf rbchs.Checked = True Then\x0d\x0a\x0d\x0atbpath.Enabled = True\x0d\x0a\x0d\x0abtndlg.Enabled = True\x0d\x0a\x0d\x0aElse\x0d\x0a\x0d\x0atbpath.Enabled = False\x0d\x0a\x0d\x0abtndlg.Enabled = False\x0d\x0a\x0d\x0aEnd If\x0d\x0a\x0d\x0aEnd Sub\x0d\x0a\x0d\x0a Private Sub run()\x0d\x0a\x0d\x0aIf tbfileName.Text = "" Then\x0d\x0a\x0d\x0aMsgBox("请输入
文件名称")\x0d\x0a\x0d\x0abtnOK.Enabled = True\x0d\x0a\x0d\x0abtnExit.Enabled = True\x0d\x0a\x0d\x0aExit Sub\x0d\x0a\x0d\x0aElse\x0d\x0a\x0d\x0anewSearcher = New getFileByName(tbfileName.Text)\x0d\x0a\x0d\x0anewSearcher.GetDrivers()\x0d\x0a\x0d\x0atmr.Enabled = True\x0d\x0a\x0d\x0atmr.Interval = 10\x0d\x0a\x0d\x0aEnd If\x0d\x0a\x0d\x0aEnd Sub\x0d\x0a\x0d\x0a Private Sub run(ByVal path As String)\x0d\x0a\x0d\x0aIf tbfileName.Text = "" Then\x0d\x0a\x0d\x0aMsgBox("请输入文件名称")\x0d\x0a\x0d\x0abtnOK.Enabled = True\x0d\x0a\x0d\x0abtnExit.Enabled = True\x0d\x0a\x0d\x0aExit Sub\x0d\x0a\x0d\x0aElse\x0d\x0a\x0d\x0anewSearcher = New getFileByName(tbfileName.Text)\x0d\x0a\x0d\x0anewSearcher.SearchFolder(path)\x0d\x0a\x0d\x0atmr.Enabled = True\x0d\x0a\x0d\x0atmr.Interval = 50\x0d\x0a\x0d\x0aEnd If\x0d\x0a\x0d\x0aEnd Sub\x0d\x0a\x0d\x0a Private Sub tmr_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmr.Tick\x0d\x0a\x0d\x0aLblshow.Text = newSearcher.currentPath\x0d\x0a\x0d\x0aIf newSearcher.cntThread = 0 And newSearcher.isDone Then\x0d\x0a\x0d\x0a'MsgBox(newSearcher.getFile.ToString)\x0d\x0a\x0d\x0a'MsgBox("全部线程结束")\x0d\x0a\x0d\x0aFor Each Str As String In newSearcher.getFile\x0d\x0a\x0d\x0atv.Nodes.Add(Str)\x0d\x0a\x0d\x0aNext\x0d\x0a\x0d\x0a'For i As Integer = 0 To newSearcher.getFile.Length - 1\x0d\x0a\x0d\x0a'tv.Nodes.Add(newSearcher.getFile(i))\x0d\x0a\x0d\x0a'Next\x0d\x0a\x0d\x0atmr.Enabled = False\x0d\x0a\x0d\x0abtnExit.Enabled = True\x0d\x0a\x0d\x0abtnOK.Enabled = True\x0d\x0a\x0d\x0aEnd If\x0d\x0a\x0d\x0aMy.Application.DoEvents()\x0d\x0a\x0d\x0aEnd Sub\x0d\x0a\x0d\x0a Private Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click\x0d\x0a\x0d\x0aMe.Close()\x0d\x0a\x0d\x0aEnd Sub End ClassDim a() As String
Private Sub Dir1_Change()
File1.Path = Dir1.Path
Label1.Caption = Dir1.Path
End Sub
Private Sub Drive1_Change()
On Error GoTo err1
Dir1.Path = Drive1.Drive
Exit Sub
err1:
MsgBox Err.Description, vbInformation + vbOKOnly, "提示"
End Sub
Private Sub Command1_Click()
Dim i As Integer, j As Integer
Dim ifieldcount As Integer, irecordcount As Integer
Dim wdapp As Word.Application
Dim wddoc As Word.Document
Dim atable As Word.Table
If Option2.Value = True Then
ReDim a(1 To File1.ListCount)
For i = 1 To File1.ListCount
b = File1.List(i)
a(i) = b
Next
End If
If Option1.Value = True Then
ReDim a(1 To Dir1.ListCount)
For i = 1 To Dir1.ListCount
b = Dir1.List(i)
a(i) = b
Next
End If
End Sub
这段程序 复制过去 就行了 创建的控件有 两个option 让你选择 要提取文件夹 还是文件路径的 选中option 1 就是提取文件夹的 option2 就是提取文件的 然后再创建 Drive1 Dir1 File1 这三个 选择文件路径的 控件 再加一个 command 按钮 就行了 有疑问再联系我!!!!!这个 只是 文件路径 你看看 是你想要的话 我再给你写 提取文件夹和文件名的代码!!!!
评论列表(0条)