Document Control

Private Const PLACEHOLDER_TEXT As String = " "

Private Const docNumber As String = "Part Number"

Private Const revLetter As String = "Document Status"

Private Const docFolder As String = "C:\datasheets"

Private Const PDFFILEPATH As String = "C:\datasheets\PDFs"

Private Const stampDocumentNumber As String = "document number"

Private Const stampRevision As String = "revision"

Private Const stampFileLocation As String = "file location"

Private Const stampUser As String = "user id"

Private Const stampComputer As String = "computer id"

Private Const stampDatetime As String = "datetime"

Sub printPDF()

'Active document

Dim myDoc As Document

Set myDoc = ActiveDocument

'Set Stamp Variables

'Document Number (Part Number)

Dim documentNumber As String

documentNumber = myDoc.SelectContentControlsByTag(docNumber)(1).Range.Text

'Document Revision

Dim revisionLetter As String

revisionLetter = myDoc.SelectContentControlsByTag(revLetter)(1).Range.Text

'File Location

Dim fileLocation As String

fileLocation = docFolder

'User

Dim macroUser As String

macroUser = Environ$("username")

macroUser = LCase(macroUser)

'Computer

Dim macroComputer As String

macroComputer = Environ$("computername")

macroComputer = LCase(macroComputer)

'Datetime

Dim timeOnly As String

Dim dateOnly As String

Dim dateTime As String

timeOnly = Format(Time, "hhmmss")

dateOnly = Format(Date, "yyyymmdd")

dateTime = dateOnly & timeOnly

'Document filename

Dim myDocFullPath As String

'myDocFullPath = myDoc.AttachedTemplate.Path

'Autosave document if it is new

If (myDoc.Path = "") Then

'Create path and name for new Word document

myDocFullPath = docFolder & "\" & documentNumber & ".docx"

'Save new document

myDoc.SaveAs2 FileName:=myDocFullPath

Else

myDoc.Save

End If

'Lock stamp CCs

myDoc.SelectContentControlsByTag(stampDocumentNumber)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampRevision)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampFileLocation)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampUser)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampComputer)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampDatetime)(1).LockContents = True

'Unlock stamp CCs

myDoc.SelectContentControlsByTag(stampDocumentNumber)(1).LockContents = False

myDoc.SelectContentControlsByTag(stampRevision)(1).LockContents = False

myDoc.SelectContentControlsByTag(stampFileLocation)(1).LockContents = False

myDoc.SelectContentControlsByTag(stampUser)(1).LockContents = False

myDoc.SelectContentControlsByTag(stampComputer)(1).LockContents = False

myDoc.SelectContentControlsByTag(stampDatetime)(1).LockContents = False

'Set PDF stamp fields

myDoc.SelectContentControlsByTag(stampDocumentNumber)(1).Range.Text = documentNumber

myDoc.SelectContentControlsByTag(stampRevision)(1).Range.Text = revisionLetter

myDoc.SelectContentControlsByTag(stampFileLocation)(1).Range.Text = fileLocation

myDoc.SelectContentControlsByTag(stampUser)(1).Range.Text = macroUser

myDoc.SelectContentControlsByTag(stampComputer)(1).Range.Text = macroComputer

myDoc.SelectContentControlsByTag(stampDatetime)(1).Range.Text = dateTime

'PDF filename

Dim PDFFILEPATHNAMEEXT As String

PDFFILEPATHNAMEEXT = PDFFILEPATH & "\" & documentNumber & ".pdf"

'Save as PDF

myDoc.SaveAs2 _

FileName:=PDFFILEPATHNAMEEXT, _

FileFormat:=wdFormatPDF

'Clear PDF stamp fields

myDoc.SelectContentControlsByTag(stampDocumentNumber)(1).Range.Text = PLACEHOLDER_TEXT

myDoc.SelectContentControlsByTag(stampRevision)(1).Range.Text = PLACEHOLDER_TEXT

myDoc.SelectContentControlsByTag(stampFileLocation)(1).Range.Text = PLACEHOLDER_TEXT

myDoc.SelectContentControlsByTag(stampUser)(1).Range.Text = PLACEHOLDER_TEXT

myDoc.SelectContentControlsByTag(stampComputer)(1).Range.Text = PLACEHOLDER_TEXT

myDoc.SelectContentControlsByTag(stampDatetime)(1).Range.Text = PLACEHOLDER_TEXT

'Lock stamp CCs

myDoc.SelectContentControlsByTag(stampDocumentNumber)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampRevision)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampFileLocation)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampUser)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampComputer)(1).LockContents = True

myDoc.SelectContentControlsByTag(stampDatetime)(1).LockContents = True

End Sub

Private Sub btnPrintPDF_Click()

'Set button enables

btnUnlock.Enabled = True

btnPrintPDF.Enabled = False

printPDF

ActiveDocument.Protect (wdAllowOnlyReading)

End Sub

Private Sub btnUnlock_Click()

'Set button enables

btnUnlock.Enabled = False

btnPrintPDF.Enabled = True

ActiveDocument.Unprotect

End Sub