VBA打开件夹下所有文.docVIP

?????????‘sub xlsOpen() Set rrr = CreateObject(Scripting.FileSystemObject) Set r = rrr.GetFolder(D:\EXCEL练习\) ?????????? Application.ScreenUpdating = False For Each i In r.Files Workbooks.Open Filename:=( D:\EXCEL练习\ + i.Name + ) ??????????????? Sheets(1).Cells(2,5 )=“10” ActiveWorkbook.Close savechanges:=true ??????Next???????????????????? Application.ScreenUpdating = True??????? ‘End Sub??? ????????? ???????????????????????????????????????????????????????? ??????????????? ? ExecuteExcel4Macro PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE) ‘打印当前SHEET ActiveWorkbook.Close savechanges:=false?? ‘不保存关闭 ActiveWorkbook.Close savechanges:=true ‘保存关闭 ?set rrr = CreateObject(Scripting.FileSystemObject) ‘sub SHEET ,range ? Set r = rrr.GetFolder(D:\EXCEL练习) Application.ScreenUpdating = False ? For Each i In r.Files ? Workbooks.Open Filename:=(D:\EXCEL练习\ + i.Name + ) ‘+= Sheets(1).Select Range(d2).Select ActiveCell.FormulaR1C1 = 11 ActiveWorkbook.Close savechanges:=true Next Application.ScreenUpdating = True ‘End Sub Dim wjm ‘Sub dir用法 ? wjm = Dir(D:\EXCEL练习\*.xls) ? MsgBox wjm ??? Do While wjm ??? 当指定路径中有文件时进行循环 ??? MsgBox wjm ???? wjm = Dir:? 找寻下一个*.xls文件 Loop? ?? ‘End Sub??dir用法 Dim MyPath$, MyName$, sh As Worksheet, arr ‘SUB能用原版Set sh = ActiveSheetMyPath = ThisWorkbook.Path \ MyName = Dir(MyPath *.xls) Application.ScreenUpdating = False [a1].CurrentRegion.Offset(2).ClearContentsDo While MyName If MyName ThisWorkbook.Name ThenWith GetObject(MyPath MyName).Close FalseEnd WithEnd IfMyName = DirLoopApplication.ScreenUpdating = TrueMsgBox ok ‘end sub能用原版 ? Dim MyPath$, MyName$, sh As Worksheet, arr ‘sub能用改版 MyPath =(D:\EXCEL练习\) ‘MyPath = ThisWorkbook.Path \ MyName = Dir(MyPath *.xls)? Application.ScreenUpdating = False ?Do While MyName ‘If MyName ThisWorkbook.Name Then? With GetObject(MyPath MyName) ‘ Workbooks.Open (MyPath MyName) .Sheets(1).Cells(2,7 )=MyPath MyName ‘Sheets