Consulting

Results 1 to 13 of 13

Thread: Excel style SaveCopyAs for Word

  1. #1
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    262
    Location

    Excel style SaveCopyAs for Word

    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
    Last edited by SamT; 11-22-2016 at 09:38 PM.

  2. #2
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,082
    Location
    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.
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  3. #3
    VBAX Regular
    Joined
    Jul 2016
    Posts
    40
    Location
    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

  4. #4
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    262
    Location
    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??

  5. #5
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    262
    Location
    I tried adding a line: Application.Run AND SUB.RUN "Workbook_BeforeClose" but I don't think I'm on the right track.

  6. #6
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,082
    Location
    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.
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  7. #7
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,082
    Location
    Mikewi,

    Hunh?
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  8. #8
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    262
    Location
    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.
    Last edited by Kilroy; 11-22-2016 at 03:31 PM.

  9. #9
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,082
    Location
    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.

    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
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  10. #10
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    262
    Location
    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

  11. #11
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,082
    Location
    <-- me

    Title changed
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  12. #12
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  13. #13
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    262
    Location
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •