Hello,

I´m trying to create a Macro in Word 2013, but I am completely new to this, so I am hoping somebody can help me.
I have a folder with many subfolders, which are filled with txt-files on a regular basis that have to be formatted in a certain way, saved as pdf and then deleted afterwards.

So, the basic steps of the Macro are:
1. Replace various text parts with predefined alternative words
2. Change the font size to 12, font to Calibri and save as pdf afterwards
3. Delete the txt-files, after they have been saved as pdf

So far, I have been able to collect some code through googling, which allows me to do all these things (in two different macros) but only for the top folder.

So I am hoping that somebody could maybe restructure the code, to have it include the txt-files in the subfolders for all these steps and possibly make one "big" macro out of it, instead of two.

Thank you!!

Kind regards,

NoS


Sub Test()
'
' Test Makro
'
'
Dim File
Dim path As String
path = "C:\Test\"
' note the "\"

File = Dir(path & "*.txt")
Do While File <> ""
Documents.Open FileName:=path & File
With ActiveDocument

With .Range.Find
.Text = "</p></li> </ul> <p>"
.Replacement.Text = "^p^p"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</p></li> <li><p>"
.Replacement.Text = "^p^p"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</p> <ul> <li><p>"
.Replacement.Text = "^p^p"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</li> </ul> <p>"
.Replacement.Text = "^p^p"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</p> <ul> <li>"
.Replacement.Text = "^p^p"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</p> </div>"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</p> <p>"
.Replacement.Text = "^p^p"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</p>"
.Replacement.Text = "^p^p"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</em>"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "<em>"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</strong>"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "<strong>"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "<a"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "</a></strong>"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "href=*>"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "<div class=""md""><p>"
.Replacement.Text = "^p^p"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "'"
.Replacement.Text = "'"
.Execute Replace:=wdReplaceAll
End With

With .Range.Find
.Text = "&quot;"
.Replacement.Text = "”"
.Execute Replace:=wdReplaceAll
End With



'Following code changes the font size to 12, the font to Calibri, the extension of the opened txt file to pdf, without displaying the pdf
Selection.WholeStory
Selection.Font.Size = 12
Selection.Font.Name = "Calibri"
ActiveDocument.Save
pdfFileName = ActiveDocument.FullName ' get the current file name
lengthFileName = Len(pdfFileName) ' get the length of the current file name (includes the path)
pdfFileName = Left(pdfFileName, lengthFileName - 3) + "pdf" ' changes the extension (shave off three characters and add three new ones.)


ActiveDocument.ExportAsFixedFormat OutputFileName:=pdfFileName, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
.Close
End With


File = Dir()
Loop
End Sub










Sub Delete_txt_files()
'Be sure that no file is open in the folder
Dim FSO As Object
Dim MyPath As String
Dim File As Object
Dim Folder As Object
Dim SubFolder As Object

Set FSO = CreateObject("scripting.filesystemobject")

MyPath = "C:\Test\" '<< Change

If Right(MyPath, 1) = "\" Then
MyPath = Left(MyPath, Len(MyPath) - 1)
End If

If FSO.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If

On Error Resume Next
'Delete files
FSO.deletefile MyPath & "\*.txt", True


End Sub
'Option Explicit