文件夹下的所有指定excel文件的指定sheet表中新增一列,并移动至新文件夹下
上一篇 / 下一篇 2010-07-19 09:46:55 / 个人分类:vbs
Set fso = CreateObject("scripting.FileSystemObject")
ModCZZJ "F:\mysoft\AutoTestV1.1\TestResource",fso,rootFolderLevel
往非操作组件文件夹下的操作组件.xlsx文件中的非附及非目录sheet表中增加一新列,并把这些文件移到到新文件夹下。
Function ModCZZJ(strPath,fso,rootFolderLevel)
Dim currFolderLevel ''记录当前文件夹的目录层级
Dim arrPath ''记录传入的目录文件夹 以““\"分裂后的各段
arrPath = split(strPath,"\",-1,1)
currFolderLevel = ubound(arrPath)''
colMum = currFolderLevel - rootFolderLevel + 1 ' ''当前文件夹将被列在第几列:当前文件夹层级 减去 根目录层级
Set Folder = fso.GetFolder(strPath)
Set Folders = oFolder.Subfolders
For each Folder in Folders
If colMum = 1 Then
fPATH = Folder.PATH
Set TheSubFolders = Folder.Subfolders
If TheSubFolders.count>0 then
subFolderIsExist = true
else
subFolderIsExist = false
intCurrRow = intCurrRow + 1'''展示的行号,加1
End If
Set Files = Folder.Files
For Each oFile In Files''把文件夹下的所有excel文件列出来
pFilePath = oFile.Path
If instr(1,OpFilePath,"操作组件.xlsx")>0 and not instr(1,OpFilePath,"操作组件\")>0 then
Rpt_CreateFlodar Folder.path,"操作组件"
newfPATH = fPATH &"\操作组件\"
Set fso = CreateObject("scripting.FileSystemObject")
Set Excel = CreateObject("Excel.Application")
Set bjWorkbook = Xls_OpenWorkbook(oExcel,OpFilePath)
sheetsCounts = objWorkbook.Sheets.count
For icount = 1 to sheetsCounts
Set bjSheet = objWorkbook.Sheets(icount)
sheetname = objSheet.NAME
If not instr(1,sheetname,"附_")>0 and not instr(1,sheetname,"附1")>0 and not instr(1,sheetname,"附2")>0 and not instr(1,sheetname,"附3")>0 and not instr(1,sheetname,"Sheet")>0 and not instr(1,sheetname,"目录")>0Then
With objSheet
If .Cells(1,12).value = "" Then
.Range("K:K").Insert
.Cells(1,11).value = "新增列名" '增加的那列
End If
End With
Set bjSheet = Nothing
End If
Next
oExcel.ActiveWorkbook.Save
oExcel.Quit
Set bjSheet = Nothing
Set bjWorkBook = Nothing
Set Excel = Nothing
fso.MoveFile oFile,newfPATH '移动文件
newfPATH = empty
End If
Next
If subFolderIsExist then''如果存在子文件夹,就继续递归
ModCZZJ Folder.path,fso,rootFolderLevel
else
End If
else
Set TheSubFolders = Folder.Subfolders
If TheSubFolders.count>0 then
subFolderIsExist = true
else
subFolderIsExist = false
intCurrRow = intCurrRow + 1'''展示的行号,加1
End If
Set Files = Folder.Files
For Each oFile In Files''把文件夹下的所有excel文件列出来
pFilePath = oFile.Path
If instr(1,OpFilePath,"操作组件.xlsx")>0 and not instr(1,OpFilePath,"操作组件\")>0 then
Rpt_CreateFlodar Folder.path,"操作组件"
newfPATH = Folder.path &"\操作组件\"
Set fso = CreateObject("scripting.FileSystemObject")
Set Excel = CreateObject("Excel.Application")
Set bjWorkbook = Xls_OpenWorkbook(oExcel,OpFilePath)
sheetsCounts = objWorkbook.Sheets.count
For icount = 1 to sheetsCounts
Set bjSheet = objWorkbook.Sheets(icount)
sheetname = objSheet.NAME
If not instr(1,sheetname,"附_")>0 and not instr(1,sheetname,"附1")>0 and not instr(1,sheetname,"附2")>0 and not instr(1,sheetname,"附3")>0 and not instr(1,sheetname,"Sheet")>0 and not instr(1,sheetname,"目录")>0Then
With objSheet
If .Cells(1,12).value = "" or .Cells(1,12).value = empty Then
.Range("K:K").Insert
.Cells(1,11).value = "新增列名"
End If
End With
Set bjSheet = Nothing
end if
Next
oExcel.ActiveWorkbook.Save
oExcel.Quit
Set bjSheet = Nothing
Set bjWorkBook = Nothing
Set Excel = Nothing
fso.MoveFile oFile,newfPATH '移动文件
newfPATH = empty
End If
Next
If subFolderIsExist then''如果存在子文件夹,就继续递归
ModCZZJ Folder.path,fso,rootFolderLevel
else
End If
end if
NEXT
End Function
TAG:
标题搜索
日历
|
|||||||||
日 | 一 | 二 | 三 | 四 | 五 | 六 | |||
1 | 2 | 3 | 4 | 5 | 6 | ||||
7 | 8 | 9 | 10 | 11 | 12 | 13 | |||
14 | 15 | 16 | 17 | 18 | 19 | 20 | |||
21 | 22 | 23 | 24 | 25 | 26 | 27 | |||
28 | 29 | 30 |
我的存档
数据统计
- 访问量: 3431
- 日志数: 6
- 图片数: 1
- 建立时间: 2009-08-31
- 更新时间: 2011-04-19