'Macro recorded/Edited 9/26/06 by ziggy

Sub FileOpenTest()

Dim FileToOpen
Dim FileToSave


Dim szFileName As String
Dim wrdDoc As Document
'''This is just demonstrate the below library function.
szFileName = FileOpenCustom1("", "*.Doc;*.txt")


'''In reality it would be more productive to pass a document object back.
If szFileName <> "" Then
Set wrdDoc = Word.Documents(szFileName)

' disabled
' MsgBox wrdDoc.Path + Chr$(13) + wrdDoc.Name


FileToOpen = wrdDoc.Name


'Modified Ziggy sept 29 2006
'Parse out .txt and replace with .doc
FileToSave = Left(wrdDoc.Name, Len(wrdDoc.Name) - 4) & ".doc"


Dim varDocOne As Variant


Documents.Open FileName:=FileToOpen, ConfirmConversions:=False, ReadOnly:= _
False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto
Selection.WholeStory
Selection.Font.Size = 8
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0.92)
.BottomMargin = InchesToPoints(0.92)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.GutterPos = wdGutterPosLeft
End With
ChangeFileOpenDirectory _
"C:\Reports" ' Make Sure directory exists
ActiveDocument.SaveAs FileName:=FileToSave, FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
MsgBox "File " & FileToSave & " Saved to:" & vbNewLine & vbNewLine & " C:\Reports"

ActiveDocument.Close



End If
End Sub
'''
''' Function: FileOpenCustom
'''
''' Comments: Returns the document name if successful. Path of
''' document should be obtained from the document via
''' FileNameFromWindow$() minus the return value.
'''
''' Arguments: pszInitDir$ initial directory.
''' pszFilter$ initial filters to use in dialog.
'''
''' Returns: Filename for success, empty string for failure.
'''
''' Date Developer Action
''' ------------------------------------------------------------------
''' 6/07/96 Steven (Smitch) Mitchell Created
''' Copyright Baarns Consulting Group, Inc. 1996
'''
Function FileOpenCustom1(pszInitDir As String, pszFilter As String) As String
Dim dlgFileOpen As Word.Dialog
Dim szCurDir As String
Dim szdlgFullName As String
Dim wrdDoc As Word.Document

'''Store the current document path
szCurDir = Application.Options.DefaultFilePath(wdDocumentsPath)
'''If pszInitDir is empty use the default path.

' Set the default directory. 'Modified Ziggy sept 29 2006
' Note: Substitute any existing directory.
Options.DefaultFilePath(Path:=wdDocumentsPath) = "\\ServerTest"


If pszInitDir <> "" Then
ChDir pszInitDir
Else
pszInitDir = szCurDir
End If
'''Initailize and reference the dialog object.
Set dlgFileOpen = Word.Dialogs(wdDialogFileOpen)
With dlgFileOpen
'''Update the dialog object.
.Update

'''Set the filter
.Name = pszFilter
'''Display and execute the dialog.
If .Show() <> False Then
'''If the user didn't cancel...
'''The active document is the one just opened.
Set wrdDoc = ActiveDocument
'''Cheat and use the document object to do the parsing.
'''Return the name of the document.
FileOpenCustom1 = wrdDoc.Name

End If
End With

'''Restore the default path setting.
With Application.Options
If .DefaultFilePath(wdDocumentsPath) <> szCurDir Then
.DefaultFilePath(wdDocumentsPath) = szCurDir
End If
End With
End Function