Excel VBA - 文本文件和文件夹操作实例集锦(10)

m = 1

With myFs

.NewSearch

.LookIn = myPath

.FileType = msoFileTypeNoteItem .Filename = \

.SearchSubFolders = True

If .Execute(SortBy:=msoSortByFileName) > 0 Then n = .FoundFiles.Count

ReDim myfile(1 To n) As String For i = 1 To n

myfile(i) = .FoundFiles(i) Filename = myfile(i)

aa = InStrRev(Filename, \

nm = Right(Filename, Len(Filename) - aa) gzbnm = Left(nm, Len(nm) - 4)

If gzbnm <> nm2 Then m = m + 1

myfile(i) = Replace(myfile(i), myPath & \ Filename = myfile(i)

aa = InStrRev(Filename, \ wjj = Left(Filename, aa - 1) Cells(m, 1) = wjj m = m + 1

Cells(m, 2) = gzbnm

Workbooks.Open .FoundFiles(i) Dim wb As Workbook Set wb = ActiveWorkbook For Each sh In Sheets m = m + 1

Sht1.Cells(m, 3) = sh.Name Next sh

wb.Close savechanges:=False Set wb = Nothing End If Next Else

MsgBox \该文件夹里没有任何文件\ End If End With Sht1.Select

Set myFs = Nothing

Application.ScreenUpdating = True

End Sub Sub wjjm() '文件夹名

Dim Myr&, Arr, r%, myPath$, i%, myFol, Arr1(), pa1, j%, aa Dim ks, js, ii&, wjj, sh As Worksheet Application.DisplayAlerts = False myPath = ThisWorkbook.Path

Myr = Sheet1.[c65536].End(xlUp).Row Arr = Sheet1.Range(\ For i = 1 To UBound(Arr) If Arr(i, 2) <> \ r = r + 1

ReDim Preserve Arr1(1 To r) Arr1(r) = i End If Next

pa1 = ThisWorkbook.Path & \当月\

For j = 1 To r

wjj = myPath & \ FileCopy wjj & \ If j <> r Then

js = Arr1(j + 1) - 2 Else

js = Myr - 1 End If