I have a number of documents in a folder. They are in a variety of formats. I have written a macro to loop through them one at a time, modify the format and save the file to a "NewFiles" folder. Occasionally a file has a problem and halts the code due to an error. I want to place them in a folder called "BadFiles", but I cant seem to get it to work. Any help is appreciated!

Here is the code thus far:

  1. Sub LoopDirectory()
  2. ' This code will allow the user to browse to a folder where MS Word documents reside.
  3. ' When executed to will loop through all documents
  4. ' Then run the referenced subs and save the modified files in a subdirectory called NewFiles.

  6. Application.FileDialog(msoFileDialogFolderPicker).Show
  7. vDirectory = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
  8. On Error GoTo Err:
  9. If Len(Dir(vDirectory & "\" & "NewFiles", vbDirectory)) = 0 Then
  10. MkDir vDirectory & "\" & "NewFiles"
  11. MkDir vDirectory & "\" & "BadFiles"
  12. End If
  13. vFile = Dir(vDirectory & "\" & "*.*")
  14. Do While vFile <> ""
  15. Documents.Open FileName:=vDirectory & "\" & vFile
  16. RemoveHeadAndFoot 'Call sub from below
  17. ActiveDocument.SaveAs (vDirectory & "\" & "NewFiles" & "\" & ActiveDocument.Name)
  18. ActiveDocument.Close
  19. vFile = Dir
  20. Loop
  21. End Sub
  22. Err:
  23. If Err.Number <> 0 Then
  24. msg "Error: " & Err.Number
  25. Err.Clear
  26. ActiveDocument.SaveAs (vDirectory & "\" & "BadFiles" & "\" & ActiveDocument.Name)
  27. ActiveDocument.Close
  28. End If
  29. End sub

  30. Sub RemoveHeadAndFoot()
  31. ' This code will remove existing Headers and Footers in all documents in the folder.
  32. Dim oSec As Section
  33. Dim oHead As HeaderFooter
  34. Dim oFoot As HeaderFooter
  35. For Each oSec In ActiveDocument.Sections
  36. For Each oHead In oSec.Headers
  37. If oHead.Exists Then oHead.Range.Delete
  38. Next oHead
  39. For Each oFoot In oSec.Footers
  40. If oFoot.Exists Then oFoot.Range.Delete
  41. Next oFoot
  42. Next oSec
  43. End Sub