Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #4  
Old 10-20-2022, 11:58 PM
gmayor's Avatar
gmayor gmayor is offline Drawing Button With VBA To Rename File And Save Windows 10 Drawing Button With VBA To Rename File And Save Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,144
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

For the macro to apply only to the document, move the macro to the document and redirect the button to its new location. It would probably be better to save the document with macro as a template and create new documents from the template to be saved as docx.

Sticking with what you propose I suggest the following. Note that if TEST FOLDER FOR WORD SAVE AS MACRO was actually part of the path, then that would have to exist or be created for it to work. (See the create folders function on my web site at Useful VBA Functions) I have removed it and the macro will save to the user's desktop. I have also added rudimnentary error handling.

Code:
Option Explicit

Sub SaveAs()
'
' SaveAs Macro
'
'

Dim sName As String, aCC As ContentControl, iSpacePos As Integer
Dim sFilename As String, sNow As String, sPath As String

    sPath = Environ("USERPROFILE") & Chr(92) & "Desktop\"
    For Each aCC In ActiveDocument.ContentControls
        If aCC.Title = "Subject" Then
            If aCC.ShowingPlaceholderText = True Then
                MsgBox "Complete the 'Subject' field!", vbCritical
                aCC.Range.Select
                Exit Sub
            End If
            sName = Trim(aCC.Range.Text)
        End If
        iSpacePos = InStr(sName, " ")
        If iSpacePos > 0 Then
            sName = Mid(sName, iSpacePos) & "," & Left(sName, iSpacePos)
            sName = Replace(sName, " ", "")
        End If
        sNow = Format(Now, "dd-mm-yy_HHMMSS")
        sFilename = sName & "_" & sNow & ".docm"

        ActiveDocument.SaveAs2 FileName:=sPath & sFilename, FileFormat:=wdFormatXMLDocumentMacroEnabled
    Next aCC
    Set aCC = Nothing
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
 

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to save Word file by field name as filename using VBA button? TribeBuckeyeFan Word VBA 4 02-02-2017 05:58 AM
Drawing Button With VBA To Rename File And Save How to save Word file by field name as filename using VBA button? chemtoli Word VBA 5 01-25-2017 08:06 AM
Save and rename attachments from ZIP FILE AndyDDUK Outlook 1 03-03-2016 12:32 AM
Drawing Button With VBA To Rename File And Save Have to rename file every time to save workbook intelli Excel 3 03-27-2014 11:53 PM
Drawing Button With VBA To Rename File And Save Rename Document & Save d4okeefe Word VBA 4 05-23-2013 09:35 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 04:53 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft