VBA Dir（）执行刷新？-Java 学习之路

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

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

这是下面的代码 . 在一个主要的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

然后我在Sub'update_Emails'的末尾使用Kill（）函数 .

1 回答

Solution One

在处理/解压缩之前备份所有.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

Solution Two

在处理它们时备份.msg . 这样，在任何给定的时间点只有一个文件副本 .

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

我没有进行任何错误处理，但请做必要的 .

Edited

我相信你在 update_Emails sub中使用了 Dir 函数 . 请参阅下文，了解 Dir 如何工作的摘要..

Dir(<dir_name or file_match_string>) - >这会将 Dir 状态重置为从开始列出文件 .
2.对 Dir() 的后续调用将列出从步骤1收集的列表中的下一个文件
3.当没有更多文件要返回时， Dir 返回空字符串 once
Dir 将在3之后超出范围并且将再次发出错误，直到您再次执行步骤1

If you do step 1 at any stage of a Dir() function call then you reset the Status to list files from start （如果你在 update_Emails Sub中随时调用 Dir(<dir_name>) ，那么你是否会打扰_1476200_中的 Dir 状态）

我相信你不得不在另一个 Dir （在 main Sub）的中间重新使用 Dir （在 update_Emails Sub内），所以我会做以下事情： -

Solution Three

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

回复于 2024-04-19T18:54:22+08:00

VBA Dir（）执行刷新？

1 回答

相关问题