none
VBA to insert some word into active word document RRS feed

  • Question

  • Hi all! I met a new question and I need your help.

    Now I want to write a macro to insert today's date and selected word into active word document without closing it. For example, I select some words "Referee mechanics on free kicks" in word, and click macro and my word file name changes to "20190224 - Referee mechanics on free kicks.docx". Without this macro, I have to repeat these steps for lots of times. 

    Now I've searched lots of websites online and just found something useful. Please help me. I need any help.

    A macro to rename active document

    Sub 文件保存()
    '
    ' 文件保存 宏
    '
    '
      Dim strDocName As String, strDocPath As String
      Dim strNewDocName As String
      Dim KillFile As String
      Dim strDate As String


      '  Get the current doc name.
      strDocName = ActiveDocument.Name
      strDocFullName = ActiveDocument.FullName
      strDocPath = ActiveDocument.Path
      strDate = Format(Date, "yyyymmdd")
      
      If strDocPath = "" Then
        MsgBox ("This document hasn't been saved. You can't rename it.")
        Exit Sub
      End If
     
      '  Pop up an input box for new name.
      strNewDocName = InputBox("Enter a new name for this document:", "Rename document", strDocName)

      '  Save the doc with newly entered name.
      ActiveDocument.SaveAs2 FileName:=strDocPath & "\" & strDate & " " & strNewDocName

      '  Delete the doc with original name.
      KillFile = strDocFullName
      Kill KillFile
    End Sub

    Sunday, February 24, 2019 6:19 PM

Answers

  • Change the line

      strNewDocName = Format(Date, "yyyymmdd - ") & strText

    to

      strNewDocName = Format(Date, "yyyymmdd - ") & strText & " By Jeremy"


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Rainbow Walker Sunday, February 24, 2019 9:06 PM
    Sunday, February 24, 2019 9:01 PM

All replies

  • This macro will save the document with the name you requested:

    Sub SaveDocAs()
      Dim strText As String
      Dim strDocPath As String
      Dim strNewDocName As String
      Dim lngType As WdSaveFormat
     
      ' Get the current filename and path.
      strDocPath = ActiveDocument.Path
      If strDocPath = "" Then
        MsgBox "This document hasn't been saved yet. You can't rename it."
        Exit Sub
      End If
     
      ' Get new name from selection.
      If Selection.Type <> wdSelectionNormal Then
        MsgBox "You haven't selected text for the file name."
        Exit Sub
      End If
     
      strText = Trim(Selection.Text)
      If strText = "" Then
        MsgBox "You haven't selected a valid file name."
        Exit Sub
      End If
     
      strNewDocName = Format(Date, "yyyymmdd - ") & strText
      If ActiveDocument.HasVBProject Then
        strNewDocName = strNewDocName & ".docm"
        lngType = wdFormatXMLDocumentMacroEnabled
      Else
        strNewDocName = strNewDocName & ".docx"
        lngType = wdFormatXMLDocument
      End If
     
      '  Save the doc with newly entered name.
      ActiveDocument.SaveAs2 FileName:=strDocPath & "\" & strNewDocName, _
        FileFormat:=lngType
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, February 24, 2019 7:55 PM
  • Perfect! By the way. I want to add some words after “Format(Date, "yyyymmdd - ") & strText”, like By Jeremy. How do I edit the macro to achieve it?
    Sunday, February 24, 2019 8:24 PM
  • Change the line

      strNewDocName = Format(Date, "yyyymmdd - ") & strText

    to

      strNewDocName = Format(Date, "yyyymmdd - ") & strText & " By Jeremy"


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Rainbow Walker Sunday, February 24, 2019 9:06 PM
    Sunday, February 24, 2019 9:01 PM
  • Excellent! Thanks a lot! 
    Sunday, February 24, 2019 9:07 PM