Frankwangyifang

  :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::

Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Sub chaifen()


Dim i
Dim j
i = 2
j = 4

'当前excel路径下,创建功能点、问题类2个文件夹
Path = ThisWorkbook.Path & "\功能点"
Path1 = ThisWorkbook.Path & "\问题类"
MkDir Path
MkDir Path1

Do While j < 100  '列小于100

    dirsub =Cells(1,j)'每个流程的目录名

    Set yyy = CreateObject("Scripting.FileSystemObject")
    If yyy.FolderExists(Path +"\"+ dirsub ) <> True Then
     MkDir Path +"\"+ dirsub
    end if

    If yyy.FolderExists(Path1 +"\"+ dirsub ) <> True Then
     MkDir Path1 +"\"+ dirsub
    end if

    Do While i <  ActiveSheet.UsedRange.Rows.Count+1   '行限制
 '取出单元格内容
        SearchNumber = Cells(i, j)
        If SearchNumber <> "" Then
  ' copy一个文件,此处生成2个excel文档。
           
            CopyFile "功能点模板", Path +"\"+ dirsub +"\" + Cells(1, j) + "_" + Cells(i, 3) + SearchNumber + "(功能点).xlsx", 1

            CopyFile "问题类模板", Path1+"\"+ dirsub  +"\" + Cells(1, j) + "_" + Cells(i, 3) + SearchNumber + "(问题类文档).xlsx", 1
           

        End If
       i = i + 1
    Loop
    j = j + 1
    i = 2
   
Loop


End Sub

posted on 2010-09-14 10:22  Frankwangyifang  阅读(332)  评论(0编辑  收藏  举报