已知：1、有100个WORD文档；2、每个文档已有一个文件名。求：建100个文件夹分别存文档

sina14

已知：1、某文件夹内有100个WORD文档；2、每个文档已有一个文件名。
求：一个文件夹存放1个文档。要根据这100个文档的文件名，建立100个文件夹，并把100个文件对应放入100个同名文件夹内。

szqhb

一个文件夹仅装一个文档，不妥啊，跟没有文件夹有区别吗？只能增加复杂度

zhaogang1960

短信收到，请测试
Sub Macro1()
    Dim MyPath$, MyName$, DestinationPath$, arr(), i&, m&
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.doc")
    Do While MyName <> ""
        m = m + 1
        ReDim Preserve arr(1 To m)
        arr(m) = MyName
        MyName = Dir
    Loop
    For i = 1 To m
        DestinationPath = MyPath & Replace(arr(i), ".doc", "")
        If LenB(Dir(DestinationPath, 16)) = 0 Then MkDir DestinationPath
        FileCopy MyPath & arr(i), DestinationPath & "\" & arr(i)
    Next
    MsgBox "ok"
End Sub

szqhb

zhaogang1960 发表于 2011-10-31 16:43
短信收到，请测试
Sub Macro1()
    Dim MyPath$, MyName$, DestinationPath$, arr(), i&, m&

zhao老师的代码好好，人忒好！！热心。
能否将代码修改一下，取文档的某几个字符创建文件夹（比如：前3个、前5个，或第3至6个等）

将代码应用于Excel文档，又如何修改代码？

wudixin96

1. @echo off&setlocal enabledelayedexpansion
   
2. for %%i in (*.doc *.docx) do (
   
3.    set f=%%~ni
   
4.    set f=!f:~0,3!
   
5.    if not exist !f! md !f!
   
6.    move %%i !f!\
   
7. )
   
8. pause

复制代码

这种问题用何必VBA呢，太麻烦了，用批处理吧

wudixin96

{:soso_e100:}

zhaogang1960

szqhb 发表于 2011-11-1 08:45
zhao老师的代码好好，人忒好！！热心。
能否将代码修改一下，取文档的某几个字符创建文件夹（比如：前3个 ...

Sub Macro1()
    Dim MyPath$, MyName$, DestinationPath$, arr(), i&, m&
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.doc")
    Do While MyName <> ""
        m = m + 1
        ReDim Preserve arr(1 To m)
        arr(m) = MyName
        MyName = Dir
    Loop
    For i = 1 To m
        DestinationPath = MyPath & Mid(arr(i), 3, 4) '取文档的第3至6个
        If LenB(Dir(DestinationPath, 16)) = 0 Then MkDir DestinationPath
        FileCopy MyPath & arr(i), DestinationPath & "\" & arr(i)
    Next
    MsgBox "ok"
End Sub

szqhb

zhaogang1960 发表于 2011-11-1 14:32
Sub Macro1()
    Dim MyPath$, MyName$, DestinationPath$, arr(), i&, m&
    MyPath = ThisWorkbook ...

好代码，收藏了。

tangqingfu

谢谢分享，收藏学习！

kqbt

值得收藏学习！！！