Gabe
Fri Jan 25 16:01:01 PST 2008
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
"Gabe" wrote:
> Does anyone know?
>
> "Gabe" wrote:
>
> > 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
> >
> > "Graham Mayor" wrote:
> >
> > > 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
> > >
> > > My web site www.gmayor.com
> > > Word MVP web site
http://word.mvps.org
> > > <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
> > >
> > > Gabe wrote:
> > > > 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?
> > >
> > >
> > >