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