Hi,
Im saving a file in MS Word and when i open it it shows me message to convert the file
here is the code i am using
Public Sub SaveDocumentAfterValid()
Dim fs, f, fc, f1
Dim fbase, fsubfol, fsubfol2, fsubfol3, fsubfol4, fsubfol5, fsubfol6, fname As String
Dim fname1, fbase_1, fsubfol_1, fsubfol_2, fsubfol_3 As String
Dim FirstN As String
Dim LastN As String
Dim CTN As String
Dim strClName As String
Dim strUrgencyTemp As String
Dim strActivePrinter As String
Dim strPages As String
Dim boolPrintPage1 As Boolean
Dim intALoopCounter As Integer
Dim highestValue As Integer
Dim highestValue1 As Integer
Dim currentuser As String
FirstN = Left((Trim(ThisDocument.FormFields("PMIHEADFIRSTNAME").Result)), 11)
LastN = Trim(ThisDocument.FormFields("PMIHEADSURNAME").Result)
CTN = Trim(ThisDocument.FormFields("PMIHEADIN_NUM").Result)
currentuser = fOSUserName()
strClName = LastN & " " & FirstN
fbase = "C:\Documents and Settings\"
fsubfol = currentuser & "\"
fsubfol2 = "Application Data\"
fsubfol3 = "Wescom\"
fsubfol4 = "PCCP\"
fsubfol5 = "Data\"
fsubfol6 = "Work_In_Progress\"
fname = strUrgencyTemp & _
Replace(Space(2 - Len(Month(Now()) & "")) & Month(Now()), " ", "0") & _
Replace(Space(2 - Len(Day(Now()) & "")) & Day(Now()), " ", "0") & _
strUrgency & " " & _
strSite & " " & _
LastN & ", " & _
FirstN
Set fs = CreateObject("Scripting.FileSystemObject")
If (fs.FolderExists(fbase)) Then
If Not (fs.FolderExists(fbase & fsubfol)) Then
MkDir (fbase & fsubfol)
End If
If Not (fs.FolderExists(fbase & fsubfol & fsubfol2)) Then
MkDir (fbase & fsubfol & fsubfol2)
End If
If Not (fs.FolderExists(fbase & fsubfol & fsubfol2 & fsubfol3)) Then
MkDir (fbase & fsubfol & fsubfol2 & fsubfol3)
End If
If Not (fs.FolderExists(fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4)) Then
MkDir (fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4)
End If
If Not (fs.FolderExists(fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4 & fsubfol5)) Then
MkDir (fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4 & fsubfol5)
End If
If Not (fs.FolderExists(fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4 & fsubfol5 & fsubfol6)) Then
MkDir (fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4 & fsubfol5 & fsubfol6)
End If
End If
If (fs.FileExists(fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4 & fsubfol5 & fsubfol6 & fname & ".tif")) Then
Set f = fs.GetFolder(fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4 & fsubfol5 & fsubfol6)
Set fc = f.Files
highestValue = 0
For Each f1 In fc
If ((InStr(f1.Name, fname) > 0) And ((Len(f1.Name) - 4) > fname)) Then
If (((Len(f1.Name) - 4) = Len(fname)) And (highestValue = 0)) Then
highestValue = 1
Else
If (CInt(Right(Left(f1.Name, Len(f1.Name) - 4), (Len(f1.Name) - 4) - (Len(fname) + 1))) >= highestValue) Then
highestValue = CInt(Right(Left(f1.Name, Len(f1.Name) - 4), (Len(f1.Name) - 4) - (Len(fname) + 1))) + 1
End If
End If
End If
Next
fname = fname & "~" & highestValue & ".doc"
Else
fname = fname & ".doc"
End If
On Error GoTo waserror
'Save current printer
strActivePrinter = Application.ActivePrinter
'MsgBox "Here2"
'Use dialog so we do not change the system wide default printer
With Dialogs(wdDialogFilePrintSetup)
.Printer = "Microsoft Office Document Image Writer"
.DoNotSetAsSysDefault = True
.Execute
End With
'MsgBox "Here3.1"
strPages = "1"
Application.PrintOut Background:=False, Append:=False, _
Range:=wdPrintRangeOfPages, OutputFileName:=("C:\PMITEMP\" & fname), _
Item:=wdPrintDocumentContent, Copies:=1, Pages:=strPages, _
PageType:=wdPrintAllPages, PrintToFile:=True
fs.MoveFile Source:=("C:\PMITEMP\" & fname), Destination:=(fbase & fsubfol & fsubfol2 & fsubfol3 & fsubfol4 & fsubfol5 & fsubfol6 & fname)
'MsgBox "Here5"
'Reset printer
With Dialogs(wdDialogFilePrintSetup)
.Printer = strActivePrinter
.DoNotSetAsSysDefault = True
.Execute
End With
MsgBox (fsubfol & fsubfol2 & fname & " has been saved. The document and application will now be closed.")
ThisDocument.Close _
SaveChanges:=wdDoNotSaveChanges
waserror:
If Err.Number = 5152 Then
MsgBox (fbase & fsubfol & " does not exist. The document has not been saved. Please contact IT/IS for further assistance.")
Else
MsgBox ("Error " & Err.Number & " " & Err.Description)
End If
ThisDocument.Close _
SaveChanges:=wdDoNotSaveChanges
End Sub