文件夹下的所有指定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:

 

评分:0

我来说两句

我的栏目

日历

« 2024-04-26  
 123456
78910111213
14151617181920
21222324252627
282930    

数据统计

  • 访问量: 3431
  • 日志数: 6
  • 图片数: 1
  • 建立时间: 2009-08-31
  • 更新时间: 2011-04-19

RSS订阅

Open Toolbar