Word Macro Custom Document Properties - Catasrophic Failture

Received a tip to use Custom Document Properties and tried to create four of them using the following code, but received a "catastrophic failure."  Any ideas why?    

ActiveDocument.CustomDocumentProperties.Add _
            Name:=RecCDP, LinkToContent:=False, Value:=RecValue, _
            Type:=msoPropertyTypeString
    ActiveDocument.CustomDocumentProperties.Add _
            Name:=PropCDP, LinkToContent:=False, Value:=PropValue, _
            Type:=msoPropertyTypeString
    ActiveDocument.CustomDocumentProperties.Add _
            Name:=EntityCDP, LinkToContent:=False, Value:=EntityValue, _
            Type:=msoPropertyTypeString
    ActiveDocument.CustomDocumentProperties.Add _
            Name:=RaishCDP, LinkToContent:=False, Value:=RaishValue, _
            Type:=msoPropertyTypeString
LVL 2
rvfowler2Asked:
Who is Participating?
 
PandaPantsConnect With a Mentor Commented:
Yes, that's right. Also, I didn't mean to imply that you don't know the difference between a CDP's name and it's value; rather, I meant that identifying a CDP and working with the value of that CDP can get confusing, especially since the default property of the CustomDocumentProperty object is "Value", which means that you can, in fact, retrieve the value of a CDP without explicitly asking for the contents of the "Value" property.

As I've mentioned many times in previous posts, I'm a bit anal about naming conventions, and this is exactly why I became so. While I know it drives some programmers crazy, I tend to prefix my variable names with characters that tell me the data type and often give me a clue as to its scope (e.g., "str" if it's a string that is defined globally, "s" for a string that's defined within the current procedure). I also try to name CDPs using a prefix of either "cdp" or an indication of what utility was used to create them, and I almost always refer to the specific property of an object even if that object has a default property, and that's what I'm after.

The only reason this came up is because, in evaluating your code snippets, I mistakenly applied my own naming conventions to your code and leapt to conclusions about variables, etc. That, and the presence of this particular line (#1003 in your snippet):

  sFileName = "upcsetup" & RecCDP & PropCDP & EntityCDP & RaishCDP

In this case, what I took to be variables called "RecCDP," etc., were actually the names of the CDPs themselves, and still a full step away from the values stored in those CDPs.

In any event, I did not mean to give offense, and I apologize if I did so.
0
 
rvfowler2Author Commented:
Also, I used a master doc every time, so I don't think I need to check for the existence of previous CDPs.
0
 
PandaPantsCommented:
Do you know at what point the code errored out? Any chance you can post the entire routine to look at? I don't see anything wrong with these lines, assuming there are values for each of the four variables and, obviously, that you have edit permissions on the ActiveDocument.
0
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

 
rvfowler2Author Commented:
I copied code from elsewhere and don't get the catastrophic failure any longer (seems it needed quotes around the CDP name.  However, when I repeated a SaveAs and tried to use the CDP it did not work.  See below:

SaveAs:
    ChangeFileOpenDirectory "R:\fmExports\Uploads\UPC_SETUPS\"
    Dim dlg As Dialog
    Dim sFileName As String
    sFileName = "upcsetup" & RecValue & PropValue & EntityValue & RaishValue
    Set dlg = Dialogs(wdDialogFileSaveAs)
    dlg.Name = sFileName & ".doc" 'defined and captured at beginning.
    dlg.Show 'later remove this step.
   
   
    '------------------------- Copy Rec, Prop, Entity, & Raish Values into CDPs for use in separate macros.
    ActiveDocument.CustomDocumentProperties.Add Name:="RecCDP", _
    LinkToContent:=False, Value:=RecValue, Type:=msoPropertyTypeString
   
    sFileName = "upcsetup" & RecCDP & PropCDP & EntityCDP & RaishCDP
    dlg.Name = sFileName & ".doc" 'defined and captured at beginning.
    dlg.Show 'later remove this step.
0
 
rvfowler2Author Commented:
See either the attached doc or the code below.
Sub FormatUPCSales()
'
' New way of asking user to input record number
    Dim Message, Style, Title, Default, RecValue As String
    Message = "ENTER REC# & PRESS OK" & Chr(13) & Chr(13) & _
    "or... if you haven't entered ~ & : in Income fields" & Chr(13) & _
    "or entered the Country, press Cancel."
    Title = "Enter Rec#"    ' Set title.
    RecValue = InputBox(Message, Title)
    
'Catches a cancel or 0 input (mistake) and goes to End Sub
    If RecValue = "" Then
    GoTo LastLine
    Else
    End If
    
    ChangeFileOpenDirectory "R:\fmExports\MastersandMacros"
    Documents.Open FileName:="UPC_letterhead.doc", ConfirmConversions:= _
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
        
    ChangeFileOpenDirectory "R:\fmExports"
    Selection.InsertFile FileName:="saleslist2.tab", Range:="", _
        ConfirmConversions:=False, Link:=False, Attachment:=False
    
    ChangeFileOpenDirectory "R:\fmExports\MastersandMacros"
        ActiveDocument.SaveAs FileName:="upc_tempfinal", FileFormat:=wdFormatDocument, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
        
            
    strFindText = "^t" & RecValue & "^p"
    Set rng = ActiveDocument.Range
    With rng.Find
        .Text = strFindText
        If .Execute Then
            rng.Select
        Else
            MsgBox "REC# " & RecValue & "  NOT FOUND"
            GoTo LastLine
        End If
    End With
    
    Selection.EndKey Unit:=wdLine
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    Selection.TypeBackspace
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    Selection.TypeBackspace
'--------------- Format the page

    Selection.WholeStory
    Selection.Font.Name = "Times New Roman"
    Selection.Font.Size = 12

    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(1.5), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(4.3), _
        Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(4.42), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
            
'----------------------------- Delete extra paragraph returns at end.

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'-------------------------- Copy Prop Code, Entity, & Raish and put into variable for later SaveAs

    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Cut  'Prop Code
    Dim PropValue As String
    Dim objData As MSForms.DataObject
    Set objData = New MSForms.DataObject
    objData.GetFromClipboard
    PropValue = objData.GetText
    
    Selection.MoveRight
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Cut  'Raish Code
    Dim RaishValue As String
    'Dim objData As MSForms.DataObject
    'Set objData = New MSForms.DataObject
    objData.GetFromClipboard
    RaishValue = objData.GetText
    
    Selection.MoveRight
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Cut  'Entity Code
    Dim EntityValue As String
    'Dim objData As MSForms.DataObject
    'Set objData = New MSForms.DataObject
    objData.GetFromClipboard
    EntityValue = objData.GetText
    
     
'--------------------------- RecordID into footer
' RecIDintoFooter Macro
' Macro recorded 12/17/2009 by
'
    Selection.EndKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    Selection.Cut
    Selection.TypeBackspace
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    If Selection.HeaderFooter.IsHeader = True Then
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Else
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    End If
    Selection.EndKey Unit:=wdStory
    Selection.TypeText Text:="  "
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeBackspace
    Selection.WholeStory
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 8
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
    End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

'--------------------------- END RecordID into footer
 
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    Selection.TypeBackspace
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.HomeKey Unit:=wdStory

'Format Heading
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Font.Size = 14
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    
 '----------------- "Location" different for Mr. Rodger.
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Location:" & vbTab
    Selection.EndKey Unit:=wdLine
    Selection.TypeText Text:=", "
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.EndKey Unit:=wdLine
    Selection.TypeText Text:=", "
    Selection.EndKey Unit:=wdLine
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.EndKey Unit:=wdLine
    Selection.TypeText Text:="  "
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.EndKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=1

    'Delete County
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.TypeBackspace
    '----------
    
    Selection.TypeParagraph
    Selection.TypeText Text:="Description:" & vbTab
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    
'Building and Lot
    Selection.TypeText Text:="Lot Size:" & vbTab
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Cut
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.TypeText Text:="Building Size:" & vbTab
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeBackspace
    Selection.TypeText Text:=vbTab
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdParagraph, Count:=1
'--------------
'Add Tenants for UPC
    Selection.TypeParagraph
    Selection.TypeText Text:="Tenants Pay:" & vbTab
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    
    Selection.TypeText Text:="Income:"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "~"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.TypeBackspace
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    Selection.Cut
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "income:"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.TypeText Text:= _
        "Total Gross Income:" & vbTab
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.TypeText Text:="Operating Expenses:"
    Selection.TypeParagraph
  
'-------------------------------------------------------
'Dim para As Paragraph
'Selection.HomeKey Unit:=wdStory
'Dim rng As Range '[defined earlier but commmented out?]
    With ActiveDocument.Range.Find
        .Text = ":^p$"
        .Replacement.Text = ":^t$"
        .Execute Replace:=wdReplaceAll
        .Text = "^p$"
        .Replacement.Text = "^p^t$"
        .Execute Replace:=wdReplaceAll
        .Text = "^p^w"
        .Replacement.Text = "^p^t"
        .Execute Replace:=wdReplaceAll
    End With
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^p^t$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=1

    Selection.TypeParagraph
    Selection.TypeText Text:="Total Operating Expenses:"
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.TypeText Text:="Net Operating Income:"
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.TypeText Text:="Mortgage:"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Price:" & vbTab
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Font.Size = 16
 
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="_______________________________________"
    Selection.TypeText Text:="______________________________________"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Notes:"
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Cut
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Mortgage:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=vbTab
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeBackspace
    
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(1.5)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-1.5)
    End With

'Find Price Description data
    Selection.EndKey Unit:=wdStory
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Font.Name = "Times New Roman"
    Selection.Font.Size = 14
    Selection.Cut
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "PRICE:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
        With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(4.42)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-4.42)
    End With
    Selection.EndKey Unit:=wdLine
    Selection.TypeText Text:=vbTab
    Selection.PasteAndFormat (wdPasteDefault)
    
'Find Cash data
    Selection.EndKey Unit:=wdStory
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Cut
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Notes"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.TypeText Text:="Cash:   "
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdStory
'--------
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^pIncome:"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    
    Selection.Extend 'Allows highlighting to extend to word found
        
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Total Operating Expenses:"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    
    Selection.ParagraphFormat.TabStops.ClearAll
        Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(0.25), _
    Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
        Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(4.3), _
    Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
        Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(4.42), _
    Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
    
    Selection.Paragraphs.Indent
    Selection.EscapeKey
    Selection.EscapeKey
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Total Gross Income:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Paragraphs.Outdent
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Operating Expenses:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Paragraphs.Outdent
    
    Selection.HomeKey Unit:=wdLine
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Description:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(1.5)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-1.5)
    End With

    With Selection.Find
        .Text = "Lot Size:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.ParagraphFormat.TabStops.ClearAll
    ActiveDocument.DefaultTabStop = InchesToPoints(0.5)
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(1.5), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(3.4), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
            Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(4.42), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
        
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(4.42)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-4.42)
    End With
    
'-----------------------------------------------------------------------------
' Turning all Headers into Upper Case for Mr. Rodgers.

 Selection.HomeKey Unit:=wdStory
     Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Location:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Description:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Building Size:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Lot Size:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Tenants Pay:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Income:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    'Selection.Range.Case = wdNextCase
'-------Changing for Mr. Rodgers
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.TypeBackspace
    Selection.ParagraphFormat.TabStops(InchesToPoints(0.25)).Clear
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Annual Rent Roll"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    Selection.EndKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
    Selection.TypeBackspace
    
'-------------------------
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Total Gross Income:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Operating Expenses:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Total Operating Expenses:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Net Operating Income:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Mortgage:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Price:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Cash:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Notes:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Range.Case = wdNextCase
    
'--------------Deleting Empty Fields
    With ActiveDocument.Range.Find
        .MatchWildcards = True
        .Text = "^13([A-Za-z]{1,}:[ ^t]{1,}^13)"
        '.Replacement.Text = "^p"
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
    End With


'Save As Without Rent Roll (In order to convert to PDF and publish publicly).
SaveAs:
    ChangeFileOpenDirectory "R:\fmExports\Uploads\UPC_SETUPS\"
    Dim dlg As Dialog
    Dim sFileName As String
    sFileName = "upcsetup" & RecValue & PropValue & EntityValue & RaishValue
    Set dlg = Dialogs(wdDialogFileSaveAs)
    dlg.Name = sFileName & ".doc" 'defined and captured at beginning.
    dlg.Show 'later remove this step.
    
    
    '------------------------- Copy Rec, Prop, Entity, & Raish Values into CDPs for use in separate macros.
    ActiveDocument.CustomDocumentProperties.Add Name:="RecCDP", _
    LinkToContent:=False, Value:=RecValue, Type:=msoPropertyTypeString
    
    sFileName = "upcsetup" & RecCDP & PropCDP & EntityCDP & RaishCDP
    dlg.Name = sFileName & ".doc" 'defined and captured at beginning.
    dlg.Show 'later remove this step.
    
Exit Sub
LastLine:
    Windows(1).Activate
    ActiveWindow.Close
End Sub

Open in new window

UPCSetupStarter.doc
0
 
PandaPantsCommented:
Okay, I'll look at the code. You're right, you'll need quotation marks around both the name of the CDP and the value you're assigning to it. In your first excerpt, I assumed (incorrectly) that we were looking at variable names, in which case that wouldn't apply (as the quotation marks would have been used in assigning the values to the variables).
0
 
PandaPantsConnect With a Mentor Commented:
It looks to me like there's some confusion about how to read from the CDPs. I went to the very end of the code you posted, down at the "SaveAs:" label, and made some changes. In order to test on my end, I re-defined and populated each of the variables RecValue, PropValue, EntityValue and RaishValue, then stored each of those values to a different CDP. Finally, I created new variables to hold the values of the CDPs, then extracted those values to populate my last set of variables...and THEN used that to identify the document to be retrieved.

The attached snippet ends just before the "LastLine:" label in your code.

Obviously, you won't need to redefine everything as I did, but you will need to pay attention to (a) how to retrieve the value of a CDP, and (b) the difference between a CDP's name and its value.

Hope this helps.
'SaveAs:
    ChangeFileOpenDirectory "c:\temp\fo_test\Uploads\UPC_SETUPS\"
    Dim RecValue As String, PropValue As String, EntityValue As String, RaishValue As String
    RecValue = "RecValue"
    PropValue = "PropValue"
    EntityValue = "EntityValue"
    RaishValue = "RaishValue"
    
    Dim dlg As Dialog
    Dim sFileName As String
    sFileName = "upcsetup" & RecValue & PropValue & EntityValue & RaishValue
    Set dlg = Dialogs(wdDialogFileSaveAs)
    dlg.Name = sFileName & ".doc" 'defined and captured at beginning.
    dlg.Show 'later remove this step.
    
    
    '------------------------- Copy Rec, Prop, Entity, & Raish Values into CDPs for use in separate macros.
    ActiveDocument.CustomDocumentProperties.Add Name:="RecCDP", _
        LinkToContent:=False, Value:=RecValue, Type:=msoPropertyTypeString
    ActiveDocument.CustomDocumentProperties.Add Name:="PropCDP", _
        LinkToContent:=False, Value:=PropValue, Type:=msoPropertyTypeString
    ActiveDocument.CustomDocumentProperties.Add Name:="EntityCDP", _
        LinkToContent:=False, Value:=EntityValue, Type:=msoPropertyTypeString
    ActiveDocument.CustomDocumentProperties.Add Name:="RaishCDP", _
        LinkToContent:=False, Value:=RaishValue, Type:=msoPropertyTypeString
    
Dim RecCDP_Value As String, PropCDP_Value As String, EntityCDP_Value As String, RaishCDP_Value As String
    RecCDP_Value = ActiveDocument.CustomDocumentProperties("RecCDP").Value
    PropCDP_Value = ActiveDocument.CustomDocumentProperties("PropCDP").Value
    EntityCDP_Value = ActiveDocument.CustomDocumentProperties("EntityCDP").Value
    RaishCDP_Value = ActiveDocument.CustomDocumentProperties("RaishCDP").Value
    
    sFileName = "upcsetup" & RecCDP_Value & PropCD_ValueP & EntityCDP_Value & RaishCDP_Value
    dlg.Name = sFileName & ".doc" 'defined and captured at beginning.
    dlg.Show 'later remove this step.
    
Exit Sub

Open in new window

0
 
rvfowler2Author Commented:
Thanks, I understand the difference between a name and a value.  I just read the = backwards, so assumed a value was already assigned to the CDP.  

Sorry to ask a dumb question, but I'm not sure I understand the four lines below.  What are their functions?
    RecValue = "RecValue"
    PropValue = "PropValue"
    EntityValue = "EntityValue"
    RaishValue = "RaishValue"
0
 
rvfowler2Author Commented:
Oh, sorry for being slow.   That was setting them equal to your test data.
0
 
rvfowler2Author Commented:
No, no offense taken.  Also, always appreciate the advice and hints.  I've already started changing my naming conventions.  Also, worked great.  Able to use a separate macro to insert pictures or create a pdf file without needing to gather data again through a dialogue box.  Next, will look into your tip about creating a toolbar on the fly.  For now, I've simply added a toolbar to my normal.dot.

Lastly, if we want to send the finsihed Word doc to customers, what is the code for stripping out the CDPs?  I would like to add that to a button that also creates an Outlook email on the fly and attaches the Word doc as an attachment.
0
 
PandaPantsCommented:
I generally use something like this. For what it's worth, this is also one of the reasons my CDP naming convention uses prefixes: You're less likely to encounter false positives by looking for CDP names that *start* with a string of characters than those that *contain* a string of characters. In this case, the letters "CDP" are unlikely to appear consecutively by mistake, so it's probably not a big deal. Hope this helps.
Private Sub DeleteCDPsContainingTheString_CDP()
    Dim dp As DocumentProperty
    For Each dp In ActiveDocument.CustomDocumentProperties
        If UCase(InStr(1, dp.Name, "CDP", vbTextCompare)) Then
            dp.Delete
        End If ' UCase(InStr(1, dp.Name, "CDP", vbTextCompare))
    Next dp
End Sub

Open in new window

0
 
PandaPantsCommented:
Now that I look at it, that code is pretty overwritten for such a short snippet. I wrote it years ago, and I can't understand why I thought the UCase would make any difference, especially where I put it, and even more especially since I'm explicitly using vbTextCompare (which does a textual comparison without regard to case). Also, it's unnecessary to declare the variable "dp" as a DocumentProperty since that's implicit in the next line, "For Each dp in ActiveDocument.CustomDocumentProperties". Sheesh.

Here's a cleaner copy of the code. I'll let you know in five years what else I should have done differently. ;~)
Private Sub DeleteCDPsContainingTheString_CDP()
    For Each dp In ActiveDocument.CustomDocumentProperties
        If InStr(1, dp.Name, "CDP", vbTextCompare) Then
            dp.Delete
        End If ' InStr(1, dp.Name, "CDP", vbTextCompare)
    Next dp
End Sub

Open in new window

0
 
PandaPantsConnect With a Mentor Commented:
Just for grins, here's an even shorter version:
Private Sub DeleteCDPsContainingTheString_CDP()
    For Each dp In ActiveDocument.CustomDocumentProperties
      If InStr(1, dp.Name, "CDP", vbTextCompare) Then dp.Delete
    Next dp
End Sub

Open in new window

0
 
rvfowler2Author Commented:
Thanks, glad to know I'm helping your coding skills.  :)
Awarding points.  You've more than answered my questions.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.