|
Dim arrf(), mf&
Sub lsc()
Dim Fso As Object, i&, sFileType$, na As Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Fso = CreateObject("Scripting.FileSystemObject")
sFileType = "*.xls"
Call GetFiles(ThisWorkbook.Path, sFileType, Fso)
For j = 1 To mf
With Workbooks.Open(arrf(j))
For Each sh In Worksheets
sh.UsedRange.Value = sh.UsedRange.Value
Next
.Close True '保存关闭
End With
Next
mf = 0
Erase arrf
Set Fso = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "ok"
End Sub
Private Sub GetFiles(ByVal sPath$, ByVal sFileType$, Fso As Object)
Dim Folder As Object
Dim SubFolder As Object
Dim File As Object
Set Folder = Fso.GetFolder(sPath)
For Each File In Folder.Files
If File.Name Like sFileType Then
If File.Name <> ThisWorkbook.Name Then
mf = mf + 1
ReDim Preserve arrf(1 To mf)
arrf(mf) = sPath & "\" & File.Name
End If
End If
Next
If Folder.SubFolders.Count > 0 Then
For Each SubFolder In Folder.SubFolders
Call GetFiles(SubFolder.Path, sFileType, Fso)
Next
End If
Set Folder = Nothing
Set File = Nothing
Set SubFolder = Nothing
End Sub |
评分
-
1
查看全部评分
-
|