VBA Dir（）执行刷新？

Question

我有一个主要的Sub，我在其中放置了Dir（）函数，以便循环选定文件夹中的文件（由于扩展名，文件被指向特定的子文件夹）。其中一种格式是Outlook电子邮件（.msg），然后宏提取工作簿并对其进行操作，最后删除提取的工作簿。但是（这是我的问题），宏需要对附件进行操作，尽管已被删除。它看起来像Dir（）函数也包含这些附件，但收集文件的Dir（）指令在主Sub的开始处执行（它不是放置在循环中）。

我不知道如何删除附件并保留第一个文件集合。

以下是下面的代码。 在主子：

dirfilename = Dir(strfilename & "\") 
'Do the loop for all files in a folder 
Do While dirfilename <> "" 
    If InStr(1, dirfilename, ".xls", vbBinaryCompare) > 0 Then 
     update_Excel_files strfilename, dirfilename, mistakes_table_name, counter 
    ElseIf InStr(1, dirfilename, ".msg", vbBinaryCompare) > 0 Then 
     update_Emails strfilename, dirfilename, mistakes_table_name, counter 
    End If 
    dirfilename = Dir 
Loop 

然后我使用杀（）函数只在子“update_Emails”的端部。

Answer 1

解决方案一

使所有.msg文件的备份做处理前/提取

Sub main() 
    . 
    . 
    . 
    dirfilename = Dir(strfilename & "\") 
    'Make a backup of all the .msg files 
    MkDir(strfilename & "\backUP") 
    FileCopy(strfilename & "\*.msg", strfilename & "\backUP\.") 
    'Do the loop for all files in a folder 
    Do While dirfilename <> "" 
    If InStr(1, dirfilename, ".xls", vbBinaryCompare) > 0 Then 
     update_Excel_files strfilename, dirfilename, mistakes_table_name, counter 
    ElseIf InStr(1, dirfilename, ".msg", vbBinaryCompare) > 0 Then 
     update_Emails strfilename, dirfilename, mistakes_table_name, counter 
    End If 
    dirfilename = Dir 
    Loop 
    . 
    . 
    'MAKE SURE YOU CLEAN UP AT THE END OF MAIN SUB 
    Kill(strfilename & "\backUP\*.*") 
    RmDir(strfilename & "\backUP") 
End Sub 

Sub update_Emails(strfilename As String, dirfilename As String, mistakes_table_name As String, counter As Integer) 
    . 
    . 
    . 
    'PROCESS ON .MSG FILES FROM <<strfilename & "\backUP">> 
    . 
    . 
    . 
End Sub 

解决方案二

制作。味精的备份到什么时候他们被处理。这样，在任何给定的时间点只有一个文件副本。

Sub main() 
    MkDir(strfilename & "\backUP") 
    . 
    . 
    . 
    Kill(strfilename & "\backUP\*.*") 
    RmDir(strfilename & "\backUP") 
End Sub 
Sub update_Emails(strfilename As String, dirfilename As String, mistakes_table_name As String, counter As Integer) 
    . 
    . 
    'PROCESS ANY OLDER .MSG FILES FROM BAKCUP FOLDER 
    . 
    . 
    . 
    'MAKE A BACKUP OF THE FILE BEFORE IT IS KILLED 
    FileCopy(strfilename & "\" & dirfilename, strfilename & "\backUP\.") 
    Kill(strfilename & "\" & dirfilename) 
End Sub 

我还没有把任何错误处理，但请做需要。

编辑

我相信你正在使用的update_Emails子里面Dir功能。请参阅下面的摘要以了解Dir的工作方式。
1. Dir(<dir_name or file_match_string>) - >这会将Dir状态重置为从开始列出文件。
2. Dir()的后续调用将列出在列表中的下一个文件从步骤收集
3. Dir返回空字符串一次时，有没有更多的文件返回像
4 。Dir会走出范围后，将抛出一个错误，直到你一步1再次

如果步骤1在Dir()函数调用的任何阶段，那么您重置状态，列出文件从开始（本质上是你打扰Dir的状态main子，如果你打电话Dir(<dir_name>)随时在update_Emails子）

我相信你不必再使用Dir（内update_Emails亚）在Dir（在main另一个子的中间），所以我会做如下： -

解决方法三

Sub main() 
    . 
    . 
    . 
    Dim origFileList as Collection 
    dirfilename = Dir(strfilename & "\") 
    While dirfilename <> "" 
    origFileList.add(dirfilename) 
    dirfilename=Dir() 
    End While 
    'Make a backup of all the .msg files 
    MkDir(strfilename & "\backUP") 
    FileCopy(strfilename & "\*.msg", strfilename & "\backUP\.") 
    'Do the loop for all files in a folder 
    For Each dirfilename in origFileList 
    If InStr(1, dirfilename, ".xls", vbBinaryCompare) > 0 Then 
     update_Excel_files strfilename, dirfilename, mistakes_table_name, counter 
    ElseIf InStr(1, dirfilename, ".msg", vbBinaryCompare) > 0 Then 
     update_Emails strfilename, dirfilename, mistakes_table_name, counter 
    End If 
    dirfilename = Dir 
    Next dirfilename 
    . 
    . 
    'MAKE SURE YOU CLEAN UP AT THE END OF MAIN SUB 
    Kill(strfilename & "\backUP\*.*") 
    RmDir(strfilename & "\backUP") 
End Sub 

Sub update_Emails(strfilename As String, dirfilename As String, mistakes_table_name As String, counter As Integer) 
    . 
    'HERE YOU CAN USE DIR as NOW IT WILL NOT INTERFERE WITH Dir State in main 
    . 
    'PROCESS ON .MSG FILES FROM <<strfilename & "\backUP">> 
    . 
    . 
    . 
End Sub