How to create a Save As popup using a command button in Word?

Question

I have code that allows the users to enter the data (name, address, company name, city, state )which works perfectly, and when users hit submit, it populates it to the word document.

Next, if possible, I am trying to also have a save as pop up appear as soon as submit is clicked but do not know what to do next. I've tried multiple examples, but all of them give me a compile error expected end sub I need help!!

Here is my working code:

Private Sub CommandButton1_Click()
    Dim firstnamelastname As Range
    Set firstnamelastname = ActiveDocument.Bookmarks("firstnamelastname").Range
    firstnamelastname.Text = Me.TextBox1.Value
    Dim Companyname As Range
    Set Companyname = ActiveDocument.Bookmarks("Companyname").Range
    Companyname.Text = Me.TextBox2
    Dim Address As Range
    Set Address = ActiveDocument.Bookmarks("address").Range
    Address.Text = Me.TextBox3
    Dim citystatezip As Range
    Set citystatezip = ActiveDocument.Bookmarks("Citystatezip").Range
    citystatezip.Text = Me.TextBox4
    Me.Repaint
    userform1.hide

but when I add anything for saving, it doesn't work.

I am also okay with removing the userform1.hide code and adding another button for save; then userform.hide so that they can continue to write the document.

Answer 1

There is no need to use Windows API.

The Application.Dialogs property returns a Dialogs collection that represents all the built-in dialog boxes in Word. To get an object from the collection you need to pass an instance of the WdWordDialog enumeration. For example, the following code shows the SaveAs dialog with predefined values:

dim strFullPath as string
dim strRootPath as string
dim strFileName as string

strRootPath = "C:\Users\Eugene\Documents\"
strFileName = "FileName.docx"
strFullPath = strRootPath & strFileName

With appWrd.Dialogs(wdDialogFileSaveAs)
    .Name = strFullPath
    .Format = Word.WdSaveFormat.wdFormatXMLDocument
    .Show
End With

Answer 2

The following code shows a Save As dialog with the preset filter. If it is not canceled it returns the full path to which the file is saved.
This code works with 32-bit Office. For 64-bit Office, the declarations must be changed.

Place the following declarations before any Subs or Functions:

'Declarations for GetSaveAsFile
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (ByRef pOpenfilename As OPENFILENAME) As Long
Private Const OFN_EXPLORER As Long = &H80000
Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

This function shows the dialog and returns the full path:

Public Function GetSaveAsFile(Optional ByVal HWnd As Long = 0, Optional ByVal strPath As String, _
   Optional ByVal arrFilters As Variant, Optional ByRef lngFilterIndex As Long = -1, Optional ByVal strTitle As String = "") As String
  '00-01s Prompts for a file name using a SaveAs dialog
  'Returns full path; returns "" if canceled
  'Saves to default location if no path specified
  '"All Files" if no filters specified; no filter if arrFilters = ""
  'lngFilterIndex: 0-based index for selected filter (in and out); -1 if canceled
  'strTitle = "": "Save as" localized
  On Error GoTo ErrHand
  Dim typOFName As OPENFILENAME
  Const lngMAX_FILE As Long = 500           'buffer size
  Dim strFile As String                     'file name
  Dim strFilters As String                  'filters string
  Dim i As Long

  strFile = Mid$(strPath, InStrRev(strPath, "\") + 1) 'crop preset file name/pattern from path
  If IsMissing(arrFilters) Or IsEmpty(arrFilters) Then               'default: All files (*.*)
    strFilters = "All files (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
  ElseIf VarType(arrFilters) = vbString Then 'no filter
  Else                                      'compose filter string
    For i = 0 To UBound(arrFilters, 1)
      strFilters = strFilters & arrFilters(i, 0) & " (*." & arrFilters(i, 1) & ")" & vbNullChar & "*." & arrFilters(i, 1) & vbNullChar
    Next i
  End If
  strFilters = strFilters & vbNullChar      'append second vbNullChar
                                            'prepare structure
  With typOFName
    .lStructSize = Len(typOFName)
    .hwndOwner = HWnd                       'parent window
    .lpstrFilter = strFilters               'file filters
    .nFilterIndex = lngFilterIndex + 1      'preset filter index
    .lpstrFile = strFile & Space$(lngMAX_FILE - Len(strFile) - 2) 'create buffer and preset file name
    .nMaxFile = lngMAX_FILE                 'maximum length of a returned file
    .lpstrInitialDir = strPath              'initial path
    .lpstrTitle = strTitle                  'dialog title
    .flags = OFN_EXPLORER                   'show explorer style dialog
    .lpstrDefExt = ""                       'enables default extension according to selected filter
    If GetSaveFileName(typOFName) Then      'call dialog
      GetSaveAsFile = Left$(.lpstrFile, InStr(1, .lpstrFile, vbNullChar) - 1) 'cut before NullChar
      lngFilterIndex = .nFilterIndex - 1    'read filter index
    Else
      lngFilterIndex = -1
    End If
  End With

Exit Function
ErrHand: 'your error handler
End Function

Explanations to the parameters:

'HWnd: window handle of the window calling this function, e.g. your Word window; ActiveWindow.HWnd. Or you can pass 0.
'strPath: Opens the Save As dialog with this path
'arrFilter: 0-based 2-dimensioned array with one or several filter names and file extensions; or "" for All files .
'lngFilterIndex: 0 or higher if you pass an array with more than one filter definitions.
'strTitle: Your own title if you like a special one

You call the function to save a document as docx like this:

'Example to call the function:
Sub SaveDoc()

  Dim arrFilters As Variant                 '0-based 2-dim. array with filter types and extensions
  Dim strFullPath As String                 'resulting full path from dialog
  Dim lngFormat As Word.WdSaveFormat        'format to save document
    
  ReDim arrFilters(0 To 0, 0 To 1)          'prepare array for 1 filter
  arrFilters(0, 0) = "Word Document"        'filter file type
  arrFilters(0, 1) = "docx"                 'filter extension
  lngFormat = wdFormatXMLDocument 'docx format (change if you prefer another format)
  
  strFullPath = GetSaveAsFile(HWnd:=ActiveWindow.HWnd, strPath:=ActiveDocument.Path & "\", _
      arrFilters:=arrFilters, lngFilterIndex:=0, strTitle:="")
  If Len(strFullPath) > 0 Then              'skip if dialog canceled
    ActiveDocument.SaveAs2 strFullPath, lngFormat 'save active document (see reference of SaveAs2 for more parameters)
  End If

End Sub