Save As .doc from a .txt

[Gabe]

Is there a way to save a word document that is currently a .txt to a .doc in
VBA? We need it to not specify a filename so that the code can be repeated no
matter what the filename is. Is there a way to do this?

 

[Graham Mayor]

The following will save the current document as DOC with the same filename
(apart from the extension) and in the same folder

Sub SaveAsDoc()
Dim strDoc As String
Dim intPos As Integer
strDocName = ActiveDocument.FullName
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".doc"
ActiveDocument.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatDocumentDefault
End Sub

and the following will convert all the TXT files in a folder to DOC

Sub SaveAllTxtAsDoc()
Dim strFileName As String
Dim strDocName As String
Dim strPath As String
Dim oDoc As Document
Dim bConv As Boolean

sConv = Options.ConfirmConversions
Options.ConfirmConversions = False

With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
strPath = .Directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
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 & "*.txt")

While Len(strFileName) <> 0
Set oDoc = Documents.Open(strPath & strFileName)
strDocName = ActiveDocument.FullName
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".doc"
oDoc.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatDocumentDefault
oDoc.Close savechanges:=wdDoNotSaveChanges
strFileName = Dir$()
Wend
Options.ConfirmConversions = sConv
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Gabe]

Wow that worked great!, I also have some special formatting that I use in
each document, Is there any way to insert the following code into the
SaveAllTxtAsDoc Sub so that each document is formatted and then saved as a
..doc? Where would I insert it into the SaveAllTxtAsDoc?

Sub Portrait()
Selection.EndKey Unit:=wdStory
Selection.TypeBackspace
Selection.HomeKey Unit:=wdStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.WholeStory
With Selection.Font
.Name = "Courier New"
.Size = 8
.Bold = False
.Italic = False
.Spacing = -0.5
End With
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.Pagesetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(0.17)
.BottomMargin = InchesToPoints(0.17)
.LeftMargin = InchesToPoints(0.24)
.RightMargin = InchesToPoints(0.24)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
End Sub

 

[Gabe]

Does anyone know?

Wow that worked great!, I also have some special formatting that I use in
each document, Is there any way to insert the following code into the
SaveAllTxtAsDoc Sub so that each document is formatted and then saved as a
.doc? Where would I insert it into the SaveAllTxtAsDoc?

Sub Portrait()
Selection.EndKey Unit:=wdStory
Selection.TypeBackspace
Selection.HomeKey Unit:=wdStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.WholeStory
With Selection.Font
.Name = "Courier New"
.Size = 8
.Bold = False
.Italic = False
.Spacing = -0.5
End With
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.Pagesetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(0.17)
.BottomMargin = InchesToPoints(0.17)
.LeftMargin = InchesToPoints(0.24)
.RightMargin = InchesToPoints(0.24)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
End Sub

 

[Gabe]

Never mind I figured it out. Thanks again.

Sub SaveAllTxtAsDoc()
Dim strFileName As String
Dim strDocName As String
Dim strPath As String
Dim oDoc As Document
Dim bConv As Boolean

sConv = Options.ConfirmConversions
Options.ConfirmConversions = False

With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
strPath = .Directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
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 & ".doc"
oDoc.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatDocumentDefault
Call Portrait
oDoc.Save
oDoc.Close
strFileName = Dir$()
Wend
Options.ConfirmConversions = sConv
End Sub