用VB6.0新建文件

'添加两个按钮，一个label一个listbox，然后粘贴如下代码，我这里把结果保存到listbox里的，而不是数组里，如果你需要的话，百度HI我我给你改一下

Private Const DRIVE_REMOVABLE = 2

Private Const DRIVE_FIXED = 3

Private Const DRIVE_REMOTE = 4

Private Const DRIVE_CDROM = 5

Private Const DRIVE_RAMDISK = 6

Private StopFlag As Boolean

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Sub FileSearch(ByVal sPath As String, ByVal Filter As String)

Static lngFiles As Long

Dim sDir As String

Dim sSubDirs() As String

Dim lngIndex As Long

Dim lngTemp&

Dim sFilter() As String

Dim lngFilterIndex As Long

Dim bDirFlags As Boolean

sFilter = Split(Filter, ",")

DoEvents

If StopFlag = True Then Exit Sub

Label1.Caption = "当前路径" &sPath

If Right(sPath, 1) <>"\" Then sPath = sPath &"\"

lngIndex = 0

On Error GoTo Ers

sDir = Dir(sPath &"*.*", vbDirectory)

On Error GoTo 0

Do While Len(sDir)

If Left(sDir, 1) <>"." And Left(sDir, 1) <>".." Then

On Error Resume Next

bDirFlags = False

bDirFlags = GetAttr(sPath &sDir) And vbDirectory

If bDirFlags = True Then

lngIndex = lngIndex + 1

ReDim Preserve sSubDirs(1 To lngIndex)

sSubDirs(lngIndex) = sPath &sDir &"\"

If UCase(sDir) = Filter Then '匹配模式

List1.AddItem sPath &sDir '找到并记录，如果要返回请修改这里

Open sPath &sDir &"\123.log" For Output As #1 '创建文件

Close #1

End If

DoEvents

End If

On Error GoTo 0

End If

sDir = Dir

Loop

For lngTemp = 1 To lngIndex

Call FileSearch(sSubDirs(lngTemp), Filter)

Next lngTemp

Ers:

End Sub

Public Sub StartSearchDir(ByVal Filter As String)

Dim nType As Long, s As String, sDrive As String, d As String

Dim pos As Integer

s = String(256, Chr(0))

GetLogicalDriveStrings Len(s), s

Do

pos = InStr(s, Chr(0))

sDrive = Left(s, pos - 1)

If Len(sDrive) = 0 Then Exit Do

s = Mid(s, pos + 1)

nType = GetDriveType(sDrive)

If nType = DRIVE_FIXED Then

d = Left(sDrive, 2) &"\"

FileSearch d, UCase(Filter)

End If

Loop Until pos <= 0

End Sub

Private Sub Command1_Click() '测试

StopFlag = False

StartSearchDir "windows" '关键字

End Sub

Private Sub Command2_Click()

StopFlag = True

End Sub

Private Sub Form_Unload(Cancel As Integer)

End

End Sub

Sub

MkDir(Path

As

String)

VBA.FileSystem

的成员

创建一个新的目录或文件夹

不过只能一次新建一层文件夹，如MkDir

"c:\a\"

Private Sub Command1_Click()

Open Text1.Text &"\" &Text2.Text &".txt" For Output As #1

Print #1, A

Close #1

End Sub

text1路径

text2文件名

A为输出内容

---