There are a few issues with your code. There are some missing variables and there are some wrongly named variables, which probably accounts for several of the error messages. If you add Option Explicit to the top of the module, such errors become obvious when you compile the code.
Your code doesn't delete the three existing custom properties because your code conditionally deletes only properties that being with 'SD_'
If prop.Name Like "SD_*" Then
The margin values are written to the new variables. The other variables are read from bookmarks in the document. There are only two bookmarks in the example document 'Date_Expires' and 'ID_Number' so the CreatedDate value is never going to be created, as the bookmark from which that value is obtained doesn't exist. The creation date is a built-in docvariable so you can get it from there.
You may find http://www.gmayor.com/BookmarkandVariableEditor.htm useful as it lists all the bookmarks, and document properties and their values in the current document. This should help you see where the problems lie.
The following should work.
Option Explicit
Sub Get_Poster_Data()
'Declarations
Dim Poster_Parameters As String
Dim strFolder As String
Dim TMrgn As Long
Dim BMrgn As Long
Dim RMrgn As Long
Dim LMrgn As Long
Dim strDateCreated As String
Dim strDateExpires As String
Dim strIDNum As String
Dim a As Long, b As Long
Dim myMsg As String
Dim PstrSplit As Variant
Dim CPropSplit As Variant
Dim answr As Long
Dim myFile As String
Dim prop As DocumentProperty
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
strFolder = .SelectedItems(1) & "\"
End If
End With
If strFolder <> "" Then
myFile = Dir(strFolder)
Do While myFile <> ""
If myFile Like "*.docx" Then
Documents.Open FileName:=strFolder & myFile
'Determine Custom Document Properties as they currently exist (values are in points rather than inches)
With ActiveDocument.PageSetup
TMrgn = .TopMargin
BMrgn = .BottomMargin
RMrgn = .RightMargin
LMrgn = .LeftMargin
End With
'Debug.Print TMrgn & vbTab & BMrgn & vbTab & RMrgn & vbTab & LMrgn
With ActiveDocument.Bookmarks 'ID_Num, Date_Created, Date_Expires - derived from bookmarks in the document
If .Exists("Date_Expires") = True Then
strDateExpires = .Item("Date_Expires").Range
End If
If .Exists("ID_Number") = True Then
strIDNum = .Item("ID_Number").Range
End If
End With
strDateCreated = ActiveDocument.BuiltInDocumentProperties("Creation Date").Value
answr = MsgBox("Do you want to delete existing Custom Properties?", vbYesNo + vbQuestion, "Delete Existing Custom Properties")
If answr = vbYes Then
'Delete Existing Custom Properties (Custom Properties includes system generated properties, too, which I don't want to delete)
For Each prop In ActiveDocument.CustomDocumentProperties
'If prop.Name Like "SD_*" Then
MsgBox "Property Name is " & prop.Name & Chr(13) & "Property Value is " & prop.Value & "."
'Stop
prop.Delete 'Delete Existsing Custom Properties
'End If
Next
'Add New Custom Properties 4/13/2017
'Stop
ActiveDocument.CustomDocumentProperties.Add Name:="SD_Date_Created", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=strDateCreated
ActiveDocument.CustomDocumentProperties.Add Name:="SD_Date_Expires", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=strDateExpires
ActiveDocument.CustomDocumentProperties.Add Name:="SD_ID_Number", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=strIDNum
ActiveDocument.CustomDocumentProperties.Add Name:="SD_Top_Margin", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=TMrgn
ActiveDocument.CustomDocumentProperties.Add Name:="SD_Bottom_Margin", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=BMrgn
ActiveDocument.CustomDocumentProperties.Add Name:="SD_Right_Margin", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=RMrgn
ActiveDocument.CustomDocumentProperties.Add Name:="SD_Left_Margin", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=LMrgn
'Else 'Change/Confirm values of custom properties
If Poster_Parameters = "" Then
Poster_Parameters = "File Name: " & myFile & "|" & "Date Created: " & strDateCreated & "|" & "Expiration Date: " & strDateExpires & "|" & "ID Number: " & strIDNum & "|" & "Top Margin: " & TMrgn & "|" & "Bottom Margin: " & BMrgn & "|" & "Right Margin: " & RMrgn & "|" & "Left Margin: " & LMrgn & "|"
ElseIf Poster_Parameters <> "" Then
Poster_Parameters = Poster_Parameters & "^" & "File Name: " & myFile & "|" & "Date Created: " & strDateCreated & "|" & "Expiration Date: " & strDateExpires & "|" & "ID Number: " & strIDNum & "|" & "Top Margin: " & TMrgn & "|" & "Bottom Margin: " & BMrgn & "|" & "Right Margin: " & RMrgn & "|" & "Left Margin: " & LMrgn & "|"
End If
End If
End If
ActiveDocument.Close savechanges:=wdSaveChanges
myFile = Dir
Loop
answr = MsgBox("Do you want to view Custom Properties for each Poster", vbYesNo + vbQuestion, "View Custom Properties?")
If answr = vbYes Then
PstrSplit = Split(Poster_Parameters, "^")
For a = 0 To UBound(PstrSplit) 'Loop through the file names
If myMsg = "" Then 'Do nothing
ElseIf myMsg <> "" Then
myMsg = myMsg & Chr(13)
End If
CPropSplit = Split(PstrSplit(a), "|")
For b = 0 To UBound(CPropSplit)
If myMsg = "" Then
myMsg = CPropSplit(b)
Else
myMsg = myMsg & "; " & CPropSplit(b)
End If
Next
Next
MsgBox (myMsg)
Else
End If
End If
lbl_Exit:
Exit Sub
End Sub
Reply With Quote
