Really Off Topic But I Need a Word Macro


Joined
Feb 8, 2015
Messages
113
Reaction score
6
I am a retired Pastor and have 30 years of Bible Studies and Sermon I need to convert from .doc to .docx format. My current Bible software will allow me to create a personal Book of Sermons and Bible Studies if they are in .docx format. This would allow all these documents to be compiled into a book which in turn would make it searchable like any other reference book within the program.

In Documents on Windows 10 I have a folder named "Sermons and Bible Studies" and within it I have a separate folder for each year. I also have a backup copy of this structure on OneDrive and again on my backup pc.

I use Word 2010 and have found a macro on the web that allows me to run it, select the folder I want to convert and seems to work beautifully. Unfortunately, This requires me to repeatedly run the macro each time and then manually go back and delete the original .doc files. The macro code looks like this:

Sub ConvertDoc2Docx()
'
' ConvertDoc2Docx Macro
'
'
Dim strFilename As String
Dim strDocName As String
Dim strPath As String
Dim oDoc As Document
Dim fDialog As FileDialog
Dim intPos As Integer
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFilename = Dir$(strPath & "*.doc")
While Len(strFilename) <> 0
Set oDoc = Documents.Open(strPath & strFilename)
strDocName = ActiveDocument.FullName
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".docx"
oDoc.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatDocumentDefault
oDoc.Close SaveChanges:=wdDoNotSaveChanges
strFilename = Dir$()
Wend
End Sub

What I'd like to be able to do is automate the process even further. Instead of having to repeatedly have to run the macro, select the directory, manually go in and delete the old .doc files, I would like to be able to select the "Sermons and Bible Studies" or whatever directory I select and have it run in each sub-directory converting the .doc files to .docx and then going back to the directory selected and go through each sub-directory and deleting the original .doc file. Is this possible? Can anyone help me?

As I mentioned, I have these files in at least 3 locations. I really don't want the location to be hard-coded with "Sermons and Bible Studies" because I have several different other places that have .doc files in them and I eventually want to convert them as well such as "Funerals", "Weddings", "Baby Dedications", etc., each of which have sub-directories by year.

Hope this makes sense. Thanks,
Michael
 
Ad

Advertisements


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top