How to convert multiple word docs (incl subfolders) from .doc to .docx?

Question

Is there a way to edit the following VBA code in a way that it can also convert all .doc documents in sub folders and delete the original .doc?

I have quite many of them and I am not quite familiar with VBA code. Any help would be much appreciated!

Sub ConvertBatchToDOCX()
    Dim sSourcePath As String
    Dim sTargetPath As String
    Dim sDocName As String
    Dim docCurDoc As Document
    Dim sNewDocName As String

    ' Looking in this path
    sSourcePath = "H:\Vanhuspalvelut\Kotihoito\Tammelan_kotihoito\TURVALLISUUS\Pelastussuunnitelmaan_tuleva\TURVALLISUUS_SUUNNITELMA_2015"
    sTargetPath = "H:\Vanhuspalvelut\Kotihoito\Tammelan_kotihoito\TURVALLISUUS\Pelastussuunnitelmaan_tuleva\TURVALLISUUS_SUUNNITELMA_2015"

   ' Look for first DOC file
    sDocName = Dir(sSourcePath & "*.doc")
    Do While sDocName <> ""
        ' Repeat as long as there are source files
        
        'Only work on files where right-most characters are ".doc"
        If Right(sDocName, 4) = ".doc" Then
            ' Open file
            Set docCurDoc = Documents.Open(FileName:=sSourcePath & sDocName)

            sNewDocName = Replace(sDocName, ".doc", ".docx")

            With docCurDoc
                .SaveAs FileName:=sTargetPath & sNewDocName, _
                  FileFormat:=wdFormatDocumentDefault
                .Close SaveChanges:=wdDoNotSaveChanges
            End With
        End If
        ' Get next source file name
        sDocName = Dir
    Loop
    MsgBox "Finished"
End Sub

Does this answer your question? [Cycle through sub-folders and files in a user-specified root directory](https://stackoverflow.com/questions/14245712/cycle-through-sub-folders-and-files-in-a-user-specified-root-directory) — Eugene Astafiev, Dec 27 '21 at 10:07

FaneDuru · Answer 1 · 2021-12-27T12:31:50.183

1

Please use the next solution:

Add the next API function on top of the module (in the declarations area):

Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr)

Use the next adapted Sub:

Sub ConvertBatchToDOCX()
    Dim mainFolderPath As String, sDoc, arrDocs, boolProblematic As Boolean
    Dim docCurDoc As Document, sNewDocName As String, strMsg As String

    ' Looking in this path
   mainFolderPath =  "H:\Vanhuspalvelut\Kotihoito\Tammelan_kotihoito\TURVALLISUUS\Pelastussuunnitelmaan_tuleva\TURVALLISUUS_SUUNNITELMA_2015\"
   
   strMsg = "Problematic files: " & vbCrLf
   
   arrDocs = getAllDocs(mainFolderPath & "*.doc")
   If arrDocs(0) = "" Then MsgBox "No appropriate documents have been found...": Exit Sub
        
   For Each sDoc In arrDocs
        sNewDocName = Left(sDoc, InStrRev(sDoc, ".") - 1) & ".docx": ' Stop
        boolProblematic = False
        On Error Resume Next
         Set docCurDoc = Documents.Open(FileName:=sDoc)
         If Err.Number = 5174 Then
            Err.Clear: boolProblematic = True
            strMsg = strMsg & sDoc & vbCrLf
         End If
         If Not boolProblematic Then
            docCurDoc.SaveAs FileName:=sNewDocName, FileFormat:=wdFormatDocumentDefault
            docCurDoc.Close False
            Kill sDoc
            Sleep 1000
        End If
   Next
   If strMsg <> "Problematic files: " & vbCrLf Then MsgBox strMsg
   
  MsgBox "Finished"
End Sub

The function has also been adapted, in order to handle the case of not document with extension ".doc" has been found:

Private Function getAllDocs(strFold As String, Optional strExt As String = "*.*") As Variant
      Dim arrD, arrExt, arrFin, sDoc, i As Long
      arrD = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strExt & """ /b /s").StdOut.ReadAll, vbCrLf), "\")
      ReDim arrFin(UBound(arrD))
      For Each sDoc In arrD
            arrExt = Split(sDoc, ".")
            If LCase(arrExt(UBound(arrExt))) = "doc" Then
                arrFin(i) = sDoc: i = i + 1
            End If
      Next
      If i > 0 Then
        ReDim Preserve arrFin(i - 1)
      Else
        ReDim arrFin(0)
      End If
      getAllDocs = arrFin
End Function

edited Dec 27 '21 at 12:31

answered Dec 27 '21 at 10:00

FaneDuru

38,298
4
19
27

The code seems to work when I run it on test folder that has one subfolder. However when I try to run it where I need it, I get run-time error `5174`. Any idea to why? – Dec 27 '21 at 10:12
@BaselE Please, mention the **error description** and the **code line** where it is raised. Nobody can memorize the error codes, except some usual ones... But the above code return an array from **all subfolders, up to the last level**. It may be a matter of permisions... – FaneDuru Dec 27 '21 at 10:14
I get this error message `run-time error `5174´` and it highlights the following line `Set docCurDoc = Documents.Open(FileName:=sDoc)` – Dec 27 '21 at 10:18
@BaselE Please, insert the next testing code line, just before the problematic line: `Debug.Print sDoc: Stop`. What does it return in `Immediate Window` when stopped on this line? Isn't it a valid document full name? If it is correct, press `F5` and run the code until it process the next document. If it raises the error, please see what's wrong with the document in discussion... – FaneDuru Dec 27 '21 at 10:22
I get the run-time error window where it says files are not found and a filename with its path. – Dec 27 '21 at 10:28
@BaselE Do you mean the error has been changed? And what path does it show? Isn't it a correct one? if you press F5 after closing the error message window, what happens? Does it work or still remain on that error? But, did you insert the line I suggested above? If so, what does it show in Immediate Window? Did the code change any document? Does it happen on the first loop? – FaneDuru Dec 27 '21 at 10:33
The error is still the same. After I inserted the suggested line and when I run the code it highlights the the stop in the suggested line and when I press F5 again it shows me the same run-time error with a file path. should I check the files that show up in the error message? I didn't notice any changes in the floders that I checked. – Dec 27 '21 at 10:45
The code works when I get rid of the problematic files. Thanks alot for your help and patience! – Dec 27 '21 at 10:54
@BaselE if you try manually opening the problematic file, can they be open? If not, I can adapt the code to skip them and finally returning a list with them. But not now, I am not near my computer... – FaneDuru Dec 27 '21 at 10:57
Yes they open up. However It would be nice if I can skip them. – Dec 27 '21 at 11:01
@BaselE Please, test the updated code and send some feedback. – FaneDuru Dec 27 '21 at 11:15
Now the code seems to skip all the files and returns a list of all "problematic files". The code I posted in the question does change them with no problem. – Dec 27 '21 at 11:41
@BaselE Unfortunately, I cannot reproduce the error... From what I can deduce it can be a matter of placing a break in the code to let it process 'something' before opening a new document. Do you have AnyDesk installed? If yes, I will like to connect and see what happens in your installation. In this way I think I can find an appropriate way of handling the issue, since you say that the pseudo problematic documents can be manually open? Is this last conclusion/assumption a correct one? – FaneDuru Dec 27 '21 at 11:53
@BaselE Please, test the updated solution. I made some tests and I adapted the code to not return an error in case of no document '.doc' found and make the code wait for 1000 milliseconds after killing the document. If still problematic, try increasing it at 2000. in order to use `Sleep`, an API function has been added on top of the module... – FaneDuru Dec 27 '21 at 12:34
I still get the same result that is a list of "Problamtic files" and no doc documnet is changed. I noticed when I test the code on a "test directory" with one subfolder it works but when I increas the amount of subfolders it doesn´t work anymore. – Dec 27 '21 at 12:52
@BaselE Since, I cannot reproduce the error, It is difficult to imagine what's happening in your installation... I asked about AnyDesk application and eventually a connection to your computer, but no answer on this issue. In these circumstances I do not imagine how to help you... The code is tested on my installation and it works without any error. – FaneDuru Dec 27 '21 at 13:23
Unfortunately I cannot have any Desk application connected. But I appreciate your help. Thank you! – Dec 27 '21 at 13:31
@BaselE OK. No problem with me. I cannot imagine what is happening in your installation... – FaneDuru Dec 27 '21 at 13:32
I added a screenshot to the OP. I don't know if it helps to show you what I get when I run the code – Dec 27 '21 at 13:49
@BaselE I'm afraid it doesn't... It is a simple message collecting all files which could not be open because of error 5174. If I cannot reproduce the error and I cannot imagine what problem you have, I'm afraid I cannot help. – FaneDuru Dec 27 '21 at 13:53

score 0 · Answer 2 · answered Dec 27 '21 at 09:33

Maybe this could get you on the right track? (Untested)

Sub saveDOCsAsDOCXs()
  ChDir "C:\myFolderName\"
  Dim fIn As String, fOut As String, doc As Document
  fIn = Dir("*.doc")   'list first `doc` files in current folder (includes `docx`)
  Do
    If Right(fIn, 4) = ".doc" Then 'only process `doc` files
      Debug.Print "Opening " & fIn
      Set doc = Documents.Open(fIn) 'open the `doc`
      fOut = fIn & "x" 'output filename
      If Dir(fOut) <> "" Then
        Debug.Print fOut & " already exists."  'could instead delete existing like `Kill fOut`
      Else
        doc.SaveAs fOut, wdFormatXMLDocument 'save as `docx`
        Debug.Print "Saved " & fOut
      End If
      doc.Close 'close the file
    End If
    fIn = Dir() 'get next `doc` file
  Loop While fIn <> ""
End Sub

Documentation: Open, SaveAs2, Dir

Yes the posted code in OP does work but only in a specific folder. In my case I have tons of .doc documents that I want to convert to docx and are located in many subfolders :( — , Dec 27 '21 at 09:54

How to convert multiple word docs (incl subfolders) from .doc to .docx?

2 Answers2