rvfowler2
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.CustomDocum entPropert ies.Add _
Name:=RecCDP, LinkToContent:=False, Value:=RecValue, _
Type:=msoPropertyTypeStrin g
ActiveDocument.CustomDocum entPropert ies.Add _
Name:=PropCDP, LinkToContent:=False, Value:=PropValue, _
Type:=msoPropertyTypeStrin g
ActiveDocument.CustomDocum entPropert ies.Add _
Name:=EntityCDP, LinkToContent:=False, Value:=EntityValue, _
Type:=msoPropertyTypeStrin g
ActiveDocument.CustomDocum entPropert ies.Add _
Name:=RaishCDP, LinkToContent:=False, Value:=RaishValue, _
Type:=msoPropertyTypeStrin g
ActiveDocument.CustomDocum
Name:=RecCDP, LinkToContent:=False, Value:=RecValue, _
Type:=msoPropertyTypeStrin
ActiveDocument.CustomDocum
Name:=PropCDP, LinkToContent:=False, Value:=PropValue, _
Type:=msoPropertyTypeStrin
ActiveDocument.CustomDocum
Name:=EntityCDP, LinkToContent:=False, Value:=EntityValue, _
Type:=msoPropertyTypeStrin
ActiveDocument.CustomDocum
Name:=RaishCDP, LinkToContent:=False, Value:=RaishValue, _
Type:=msoPropertyTypeStrin
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.
ASKER
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.CustomDocum entPropert ies.Add Name:="RecCDP", _
LinkToContent:=False, Value:=RecValue, Type:=msoPropertyTypeStrin g
sFileName = "upcsetup" & RecCDP & PropCDP & EntityCDP & RaishCDP
dlg.Name = sFileName & ".doc" 'defined and captured at beginning.
dlg.Show 'later remove this step.
SaveAs:
ChangeFileOpenDirectory "R:\fmExports\Uploads\UPC_
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.
'-------------------------
ActiveDocument.CustomDocum
LinkToContent:=False, Value:=RecValue, Type:=msoPropertyTypeStrin
sFileName = "upcsetup" & RecCDP & PropCDP & EntityCDP & RaishCDP
dlg.Name = sFileName & ".doc" 'defined and captured at beginning.
dlg.Show 'later remove this step.
ASKER
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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"
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"
ASKER
Oh, sorry for being slow. That was setting them equal to your test data.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.
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
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.CustomDocum entPropert ies". Sheesh.
Here's a cleaner copy of the code. I'll let you know in five years what else I should have done differently. ;~)
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
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks, glad to know I'm helping your coding skills. :)
Awarding points. You've more than answered my questions.
Awarding points. You've more than answered my questions.
ASKER