Excel style SaveCopyAs for Word

[Kilroy]

I found this code here and I'm wondering how to change a couple of things. The first part of this code turns off the track changes which I need to have the same. The second part saves the file in the same folder with an extension which I also need. But Can it be modified to do the following:

1. Save the original file with the extension but to a specified folder, not the same folder, without opening it, without showing that it's been saved or closing the original? (just to save a copy as in the background to have as a backup incase I screw up the original)
2. Turn off the track changes in the original (I run more formatting macros after and tracked changes is always on)

Any help appreciated.


Sub MakeTC()
Application.ScreenUpdating = False
Dim StrName As String, StrExt As String, lFmt As Long
With ActiveDocument
.TrackRevisions = False
.ShowRevisions = False
With .ActiveWindow.View
.ShowRevisionsAndComments = False
.RevisionsView = wdRevisionsViewFinal
End With
StrName = .FullName: lFmt = .SaveFormat
StrExt = "." & Split(.Name, ".")(UBound(Split(.Name, ".")))
StrName = Left(StrName, Len(StrName) - Len(StrExt))
.SaveAs2 FileName:=StrName & "_TC" & StrExt, _
Fileformat:=lFmt, AddToRecentFiles:=False
End With
Application.ScreenUpdating = True
End Sub


Moderator Edit: This thread references KB Article; http://www.vbaexpress.com/kb/getarticle.php?kb_id=961

[SamT]

You can adopt my backup code for your use


Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not Me.Saved Then _
Me.SaveCopyAs ("E:\COMPUTING\VBA\MyPersonal\" & CDbl(Now) & " - Personal.xls")
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
Me.SaveCopyAs ("E:\COMPUTING\VBA\MyPersonal\" & CDbl(Now) & "- Personal.xls")
Me.Saved = True
End Sub

I used CDble(Now) in the B/U name just to list them in chronological order. I didn't use just the date because I might save the file several times in one day.

[mikewi]

Sam I appreciate your response but I have no idea how to run a private sub I'm still new to VBA. Learning slowly. I managed to get the track changes part of the code isolated:


Sub TrackingOff()
With ActiveDocument
.TrackRevisions = False
.ShowRevisions = False
With .ActiveWindow.View
.ShowRevisionsAndComments = False
.RevisionsView = wdRevisionsViewFinal
End With
End With
End Sub



But like I said I have no idea how to run a private sub or how to tie these two together. I would have thought your save as macro runs first and then calls up the TrackingOff sub??

Thanks

[Kilroy]

Thanks to both of you. I was just working on separating the two. I was missing the second "end with". Mikewi I think you're right. The save part must be first. Right??

[Kilroy]

I tried adding a line: Application.Run AND SUB.RUN "Workbook_BeforeClose" but I don't think I'm on the right track.

[SamT]

Kilroy, I would just add

.SaveCopyAs("E:\COMPUTING\VBA\MyPersonal\" & CDbl(Now) & .Name)

after the SaveAs2 line(s). The SaveAs2 will close the original and open the newly saved version, so the .Name will be the newly saved file name.

Obviously, you want to use your own backup folder path.

If you put Workbook_BeforeSave in the original it will also be in the newly saved version and all subsequent versions.

[SamT]

Mikewi,

Hunh?

[Kilroy]

Thanks Sam. I tried adding the line as I understood you meant and I'm getting an error saying that method is not available on that object.

Sub MakeTC()
Application.ScreenUpdating = False
Dim StrName As String, StrExt As String, lFmt As Long
With ActiveDocument
.TrackRevisions = False
.ShowRevisions = False
With .ActiveWindow.View
.ShowRevisionsAndComments = False
.RevisionsView = wdRevisionsViewFinal
End With
StrName = .FullName: lFmt = .SaveFormat
StrExt = "." & Split(.Name, ".")(UBound(Split(.Name, ".")))
StrName = Left(StrName, Len(StrName) - Len(StrExt))
.SaveAs2 FileName:=StrName & "_TC" & StrExt, _
Fileformat:=lFmt, AddToRecentFiles:=False
.SaveCopyAs ("C:\my copies\" & CDbl(Now) & .Name)
End With
Application.ScreenUpdating = True
End Sub


Also just to clarify. What I'm looking to do is comply with the requirements of the Document Control Procedure that I have to follow when revising a document. The procedure states that when I open a document to revise it I need to first create a backup and then work from the original. That’s just the way the procedure is written. Yes it is poorly written but I can't change it. So What I do now is open the document and do a Save as to C:\Original Backups\ and I add _KK to the file name, then I go back to the original folder and reopen the document and then continue on to revise the original. Most of the formatting I'm required to do now I complete using a list of about 20 macros that I copy and paste into the VBA editor as 1 large macro compilation. My hopes were that the first macro on my list could be one that automatically just saves a copy of my active document to C:\Original Backups\. Let’s just forget about turning off the track changes.

[SamT]

Stupid me. I was thinking in Excel instead of in Word

Please see: http://www.vbaexpress.com/kb/getarticle.php?kb_id=961

I won't pretend to know much about Word, but I do pretend to know how to piece bits of code together. :D

If this doesn't fix your problem, I will change the Title of this thread to "SaveCopyAs for Word" to attract a Word Expert


Sub SaveCopyAs()
Const lCancelled_c As Long = 0
Dim sSaveAsPath As String
Application.ScreenUpdating = False

sSaveAsPath = GetSaveAsPath

If VBA.LenB(sSaveAsPath) = lCancelled_c Then Exit Sub
'Save changes to original document
ActiveDocument.Save
'the next line copies the active document
Application.Documents.Add ActiveDocument.FullName
'the next line saves the copy to your location and name
ActiveDocument.SaveAs SaveName
'next line closes the copy leaving you with the original document
ActiveDocument.Close
Application.ScreenUpdating = True
End Sub



Private Function GetSaveAsPath() As String
Dim fd As Office.FileDialog
Set fd = Word.Application.FileDialog(msoFileDialogSaveAs)
fd.InitialFileName = ActiveDocument.Name
If fd.Show Then GetSaveAsPath = fd.SelectedItems(1)
End Function



Private Function SaveName() As String
Dim StrName As String, StrExt As String, lFmt As Long
With ActiveDocument
StrName = .FullName: lFmt = .SaveFormat
StrExt = "." & Split(.Name, ".")(UBound(Split(.Name, ".")))
StrName = Left(StrName, Len(StrName) - Len(StrExt))
SaveName = StrName & "_TC" & StrExt
End With
End Function

[Kilroy]

Thanks again Sam. I put the three of them together (see below) and tried to run it. It opens up a save as window but it is not calling up the second private function for adding the "_BackUp" Also is there way to code it so that a copy of the active document is automatically saved to "C:\Original Backups" instead of opening the save as window? When the save as window is used it is just keeps the newly saved document open and not the original which is the one I need to work on.

Thanks again for your efforts. I knew this would be a tough one.



Sub SaveCopyAs()
Const lCancelled_c As Long = 0
Dim sSaveAsPath As String
Application.ScreenUpdating = False

sSaveAsPath = GetSaveAsPath

If VBA.LenB(sSaveAsPath) = lCancelled_c Then Exit Sub
'Save changes to original document
ActiveDocument.Save
'the next line copies the active document
Application.Documents.Add ActiveDocument.FullName
'the next line saves the copy to your location and name
ActiveDocument.SaveAs SaveName
'next line closes the copy leaving you with the original document
ActiveDocument.Close
Application.ScreenUpdating = True
End Sub
Private Function GetSaveAsPath() As String Dim fd As Office.FileDialog Set fd = Word.Application.FileDialog(msoFileDialogSaveAs) fd.InitialFileName = ActiveDocument.Name If fd.Show Then GetSaveAsPath = fd.SelectedItems(1) End Function Private Function SaveName() As String Dim StrName As String, StrExt As String, lFmt As Long With ActiveDocument StrName = .FullName: lFmt = .SaveFormat StrExt = "." & Split(.Name, ".")(UBound(Split(.Name, "."))) StrName = Left(StrName, Len(StrName) - Len(StrExt)) SaveName = StrName & "_BackUp" & StrExt End With End Function

[SamT]

:hide: <-- me

Title changed

[gmayor]

What I think you want is the following based on code earlier in the thread.
It saves the document in its existing state and records the name and path
It then processes the document to remove the tracking and markup and saves it with a new name in the indicated folder and closes it, then re-opens the original document in its unchanged form. You may need to make changes to the revew settings if theya re not exactly what you require.


Sub MakeTC()
Application.ScreenUpdating = False
Const strPath As String = "C:\My Copies\" 'the path to save the copy
Dim lFmt As Long
Dim strOriginal As String
With ActiveDocument
.Save
If .Path = "" Then
MsgBox "The document must be saved first!"
Exit Sub
End If
lFmt = .SaveFormat
strOriginal = .FullName
.AcceptAllRevisions
.TrackRevisions = False
With ActiveWindow.View.RevisionsFilter
.Markup = wdRevisionsMarkupNone
.View = wdRevisionsViewFinal
End With
.SaveAs2 FileName:=strPath & CDbl(Now) & Chr(32) & .Name, _
Fileformat:=lFmt, _
AddToRecentFiles:=False
.Close 0
Documents.Open strOriginal
End With
Application.ScreenUpdating = True
End Sub

[Kilroy]

Guys it's working great. I think part of the problem I was having was that when I was pasting my macro in I wasn't putting it in (Normal - Modules) I was putting it into "This document" of the file I had open. I've learned from this and I truly appreciate everyone's help.