目录太深(>4000), 删除时报错

sunnirvana

犯了个很2的错误, 将上级目录拖动到下级里了, 结果导致里目录里面递归复制, 删除时提示错误信息.
原因应该是message太多, 导致不能删除.
我现在的想法是, 用VBA实现一个宏, 遍历回收站里的每一层级的目录, 找到对底层的然后开始进行删除动作, 直至所有.
有人能帮忙写个雏形吗? 或者还有还有应对这个问题其他方案.
非常感谢.

sunnirvana

没人回啊, 自己顶一下先

dsd999

你说的回收站是桌面那个回收站吗？

sunnirvana

dsd999 发表于 2013-10-18 14:15
你说的回收站是桌面那个回收站吗？

谢谢版主关心, 不是系统回收站, 是Outlook里的deleteItems.
这几天我也一直想写个宏来逐个删除, 可是都没有达到效果, 总是会报错

dsd999

能否贴出你现在写的代码？

sunnirvana

Sub DeleteFolder()
        Dim myNamespace As Outlook.NameSpace
        Dim floderCount As Long
        Dim lastFolder As Outlook.folder
        Dim tmpFolder As Outlook.folder
        Dim topFolder As Outlook.folder
        Dim parentFolder As Outlook.folder
         
        Set myNamespace = Application.GetNamespace("MAPI")
        
        Set topFolder = myNamespace.GetDefaultFolder(olFolderDeletedItems)
        Set parentFolder = topFolder
        
        Do
                If parentFolder.Folders.GetLast Is Nothing Then
                        '找到了最後一個文件夾
                        Set tmpFolder = parentFolder.Parent
                        
                        '將最後一個文件夾改名爲“Z”，這樣它就是DeleteItems文件夾中最後一個文件夾，利於第二次刪除
                        parentFolder.Name = "Z"
                        
                        '第一次刪除，會將被刪除的文件夾放到DeleteItems下
                        parentFolder.Delete
                        
                        '第二次刪除，徹底將它從DeleteItems下刪除
                        topFolder.Folders.GetLast.Delete
                                       
                        If 0 = StrComp(tmpFolder.Name, topFolder.Name, 1) Then
                                Exit Do
                        Else
                                Set parentFolder = tmpFolder
                        End If
               
                Else
                        Set parentFolder = parentFolder.Folders.GetLast
                End If
        Loop While (1)

End Sub

sunnirvana

上面程序的前提是，我已經將需要刪除的文件夾都放在了DeleteItem下，所以只要處理DeleteItem就可以了

dsd999

outlook的版本？

具体的报错？

dsd999

2003版里没有Outlook.Folder

sunnirvana

实在抱歉，没有及时回答问题。这个问题我目前已经解决了，但是用的方法比较笨。
我用的是2010的outlook，操作系统是win7 64位
先说下我的方法吧，
1，使用WEB方式直接删除服务器端的数据，而不是用outlook软件来操作。原因是我使用如上的函数进行逐层删除时，文件夹非但不会被删除，并且还会在DeleteItem目录下又创建了一个被删除的文件夹。这种方式更像是把被删除文件夹进行了一次拷贝，然后放在DeleteItem下。我认为这可能是outlook的服务器端和终端同步数据的问题。所以我放弃了在终端的删除动作，而改在直接操作服务器端数据。
2，在outlook终端写了一个函数，用来给每一层的文件夹改名字（名字是既是当前文件夹所属的层数），并统计层数。
3，发现我要删除的文件夹层数只有338个，所以我认为这应该不是item超过4000的问题。但是folder和item在outlook中又不一样，所以我想可能是outlook对folder的层级有另外的限制。
4，在WEB outlook端，我就逐层打开folder进行删除，发现到第118层时(报出的错误是：你没有权限是删除它)，才能将119层及以后的删除掉。而且这次的删除是清空，不会像终端删除那样在DeleteItem目录中再保留一份。所以我认为outlook所允许删除的最大目录层数是220左右。
5，至此找到了删除的方法，我就一直手动删除了困扰了我快两周的文件夹。