Link to home
Start Free TrialLog in
Avatar of rvfowler2
rvfowler2Flag for United States of America

asked on

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
Avatar of rvfowler2
rvfowler2
Flag of United States of America image

ASKER

Also, I used a master doc every time, so I don't think I need to check for the existence of previous CDPs.
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.
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.
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
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).
SOLUTION
Avatar of PandaPants
PandaPants
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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"
Oh, sorry for being slow.   That was setting them equal to your test data.
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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.
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

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

SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks, glad to know I'm helping your coding skills.  :)
Awarding points.  You've more than answered my questions.