Updated macro at the end
:banghead:Today I put updated macro below
No more annoying dialog boxes!
The whole is below so just copy it without the quotation marks at the beginning and at end.
"..."
That is all the problem of course it does not convert special characters.
I modified the macro so you can point it at a directory, and it will convert
ALL the VNT files it finds!
Also fixed newline characters ("=0A" in the vnt file).
Thanks Dr4GoN76 for the original. Hope people find my improvements useful!
"
Sub VNT_TO_txt()
'
' VNT_TO_txt Makro
' Makro zapisane 12-07-26 przez Wojciech Olkowski
' Improvements made 14-06-30 by "Adeptus"
'
Dim oDoc As Document
ChangeFileOpenDirectory "
C:\Downloads\" '
<- CHANGE THIS TO YOUR DIRECTORY
vFile = Dir("*.vnt")
Do While vFile <> ""
Set oDoc = Documents.Open(FileName:=vFile)
Set myRangeVNT_TO_txt = ActiveDocument.Content
Selection.HomeKey Unit:=wdStory
ActiveWindow.ActivePane.View.ShowAll = True
Selection.Find.ClearFormatting
With Selection.Find
.Text = "QUOTED-PRINTABLE:"
.Replacement.Text = ";"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "DCREATED:"
.Replacement.Text = ";"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
myRangeVNT_TO_txt.Find.Execute FindText:="=^p", ReplaceWith:="", _
Replace:=wdReplaceAll
myRangeVNT_TO_txt.Find.Execute FindText:="=0D=0A", ReplaceWith:="^p", _
Replace:=wdReplaceAll
myRangeVNT_TO_txt.Find.Execute FindText:="=0A", ReplaceWith:="^l", _
Replace:=wdReplaceAll
myRangeVNT_TO_txt.Find.Execute FindText:="\;", ReplaceWith:=";", _
Replace:=wdReplaceAll
myRangeVNT_TO_txt.Find.Execute FindText:="=20", ReplaceWith:=" ", _
Replace:=wdReplaceAll
ActiveWindow.ActivePane.View.ShowAll = False
ActiveDocument.SaveAs2 FileName:=oDoc.Name & ".txt", FileFormat _
:=wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True _
, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, Encoding:=1252, InsertLineBreaks:=False, _
AllowSubstitutions:=False, LineEnding:=wdCRLF, CompatibilityMode:=0
oDoc.Close SaveChanges:=False
vFile = Dir
Loop
End Sub
"
arty: