I am trying to force the user to always save the workbook as a newly named
file into a specific folder.  My problem is that the Save As dialog comes up
twice???? Here's my code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   'Check for Save versus SaveAs
   If SaveAsUI Then
       SaveAsFile
       CreateShortCut
   End If
End Sub

Sub SaveAsFile()
   Dim strDocName As String
   Const FilePath As String = "H:\ProdDev\Client\"

   ChDrive FilePath
   ChDir FilePath
   strDocName = Application.GetSaveAsFilename
   If strDocName <> "False" Then
       ActiveWorkbook.SaveAs Filename:=strDocName
   End If
End Sub