Foxtable(狐表)用户栏目专家坐堂 → [求助]求改管理文件代码


  共有1862人关注过本帖树形打印复制链接

主题:[求助]求改管理文件代码

帅哥哟,离线,有人找我吗?
jyh7081
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:962 积分:8505 威望:0 精华:0 注册:2012/10/3 13:25:00
[求助]求改管理文件代码  发帖心情 Post By:2016/8/30 12:40:00 [显示全部帖子]

我有一段execl中的VBA代码,是以“-”作为分界,将含有相同字符串文件名的文档,放入相同文件夹中。我想把这段代码运用到foxtable中,原代码如下:

Sub 文件管理()
    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 & Split(arr(i), "-")(0)
        If LenB(Dir(DestinationPath, 16)) = 0 Then MkDir DestinationPath
        FileCopy MyPath & arr(i), DestinationPath & "\" & arr(i)
    Next
End Sub

我修改的代码见斜体字,还需要怎样改动:

   Dim App As New MSExcel.Application
   App.Visible = False

   Dim MyPath$, MyName$, DestinationPath$, arr(), i&, m&
    MyPath = ProjectPath & "\文件\"
    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 & Split(arr(i), "-")(0)
        If LenB(Dir(DestinationPath, 16)) = 0 Then MkDir DestinationPath
        FileCopy MyPath & arr(i), DestinationPath & "\" & arr(i)
    Next




 回到顶部