Sub createFileFromExcle()
Dim fs As Object
'Set fs = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
For i = 2 To [a65536].End(xlUp).Row
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(ThisWorkbook.Path & "\" & Cells(i, 1)) Then fs.CreateFolder (ThisWorkbook.Path & "\" & Cells(i, 1)) ‘把第一列作为为目录,目录不存在则创建
If Not fs.FolderExists(ThisWorkbook.Path & "\" & Cells(i, 1) & "\"& Split(Cells(i, 2), "-")(1) ) Then fs.CreateFolder(ThisWorkbook.Path & "\" & Cells(i, 1) & "\"& Split(Cells(i, 1), "-")(1) ) ’创建子目录 Split(Cells(i, 2), "-")(1) 表示对第二列单元格去其中特定的字段,使用-分割,(1)表示取第二个字段,0表示第一个
Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Cells(i, 1) & "\" & Cells(i, 2) & ".txt", True) ‘用第二列的内容当文件名
a.WriteLine (Cells(i, 4)) '将第4列的内容写入文件
a.Close
Next
Application.ScreenUpdating = False
MsgBox "OK"
End Sub