View Single Post
 
Old 03-22-2013, 11:43 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,343
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

OK, you're using content controls. But. Since you document has access to their properties locked via a password, I can't refer to it by name ...

That said, one can still refer to it as the first content control in the document.

If you add the following code to your incident report template's 'ThisDocument' code module, you should be able to get the result you're after. The code intercepts both the File|Save and File|SaveAs processes. By default, the code attempts to save the file to the folder you nominated but, if it doesn't exist, a folder browser pops up so the user can select another one (or create the missing one).
Code:
Sub FileSaveAs()
Dim StrPath As String, StrName As String
StrPath = "C:\" & Environ("Username") & "\Temp\Documents\Forms\"
StrName = ActiveDocument.ContentControls(1).Range.Text
If StrName Like "Choose*" Then
  MsgBox "Error: Residence incomplete", vbCritical
  Exit Sub
End If
If Dir(StrPath) = "" Then
  StrPath = GetFolder
  If StrPath = "" Then
    MsgBox "No Save Path Available", vbCritical
    Exit Sub
  End If
  StrPath = StrPath & "\"
End If
With Application.Dialogs(wdDialogFileSaveAs)
  .Name = StrPath & StrName & "_" & Format(Now, "YYYYMMDD")
  .Show
End With
End Sub
 
Sub FileSave()
With ActiveDocument
  If Not Right(Left(.FullName, InStrRev(.FullName, ".") - 1), 8) Like "########" Then
    Call FileSaveAs
    Exit Sub
  End If
  .Save
End With
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote