Skip to content

Instantly share code, notes, and snippets.

@pepc pepc/convert2tabtxt.bas Secret
Created Feb 8, 2018

Embed
What would you like to do?
Convert all .docx files in a folder to .txt files that can be loaded in ApSIC Xbench
Sub Convert2TabTxt()
Dim strPath As String
Dim strFile As String
Dim doc As Document
With Application.FileDialog(4) ' msoFileDialogFolderPicker
If .Show Then
strPath = .SelectedItems(1)
Else
MsgBox "No folder specified!", vbExclamation
Exit Sub
End If
End With
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Application.ScreenUpdating = False
On Error GoTo ErrHandler
strFile = Dir(strPath & "*.docx")
Do While strFile <> ""
Set doc = Documents.Open(strPath & strFile)
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^t"
.Replacement.Text = "->"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(*)^013"
.Replacement.Text = "\1^t\1^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
doc.SaveAs2 FileName:=strPath & Replace(Expression:=strFile, _
Find:=".docx", Replace:=".txt", Compare:=vbTextCompare), _
FileFormat:=wdFormatEncodedText, Encoding:=65001 ' msoEncodingUTF8
doc.Close SaveChanges:=False
strFile = Dir
Loop
MsgBox "All files in folder processed!", vbInfo
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.