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