Embedded Files
Source Code, ThisDocument
Source Code, ThisDocument
'Used to protect dataPrivate Const MY_PASSWORD = "MY_PASSWORD"
'Used to access Content ControlsPrivate Const customer As String = "customer"Private Const contact As String = "contact"Private Const address As String = "address"Private Const datereceived As String = "dateReceived"Private Const device As String = "device"Private Const complaint As String = "complaint"Private Const caption As String = "caption"Private Const followup As String = "followup"Private Const codes As String = "codes"Private Const stamp As String = "stamp"Private Const datetimestamp As String = "datetimeStamp"Private Const picture As String = "picture"Private Const cc_dataKey As String = "datakey"
'Used to set textPrivate Const PLACEHOLDER_TEXT As String = " "Private Const INVALID_CUSTOMER_ID = "N/A"
'Used to move dataPrivate Const DATA_ARRAY_LENGTH As Long = 30
'Used to access data array ... order determines log column orderEnum formInputEnums dataRow idataKey iUser iComputer iDatetime CompanyNameFull CompanyNameShort CustomerNumber ContactName ContactPhone ContactEmail ContactFax ShippingAddress1 ShippingAddress2 ShippingCity ShippingState ShippingZip ComplaintDateRecieved ComplaintModelNumber ComplaintDeviceSN ComplaintText ComplaintCaption1 ComplaintCaption2 FollowUpTicketNumber FollowUpCode1 FollowUpCode2 FollowUpCode3 FollowUpNotes FollowUpCaption1 FollowUpCaption2End Enum
Sub saveDoc()'Nolan Manteufel'23JUL2020
Dim myDoc As DocumentSet myDoc = ActiveDocument
'Doc filenameDim myDocFullPath As StringmyDocFullPath = myDoc.AttachedTemplate.Path
'Autosave document if it is newIf (myDoc.Path = "") Then 'Datetime Dim timeOnly As String Dim dateOnly As String Dim dateTime As String timeOnly = Format(Time, "hhmmss") dateOnly = Format(Date, "yyyymmdd") dateTime = dateOnly & timeOnly 'Customer ID Dim customerID As String customerID = myDoc.SelectContentControlsByTag(customer)(2).Range.Text 'Create path and name for new Word document myDocFullPath = myDocFullPath & "\Entries\" & customerID & "_" & dateTime & ".doc" 'Save new document myDoc.SaveAs2 filename:=myDocFullPathElse myDoc.SaveEnd IfEnd Sub
Sub saveData()'Nolan Manteufel'23JUL2020
Application.StatusBar = "Saving data..."
'VariablesDim myDoc As DocumentSet myDoc = ActiveDocument
Dim dataArray(DATA_ARRAY_LENGTH) As String
Dim datakey As LongDim rowIndexFinder As LongDim rowIndex As Long
'UserDim macroUser As StringmacroUser = Environ$("username")macroUser = LCase(macroUser)
'ComputerDim macroComputer As StringmacroComputer = Environ$("computername")macroComputer = LCase(macroComputer)
'DatetimeDim timeOnly As StringDim dateOnly As StringDim dateTime As StringtimeOnly = Format(Time, "hhmmss")dateOnly = Format(Date, "yyyymmdd")dateTime = dateOnly & timeOnly
'Populate dataArray'dataRow ... leave empty, will be populated with rowIndex'dataKey ... used to locate data recordDim newEntry As BooleanIf (myDoc.SelectContentControlsByTag(cc_dataKey)(1).Range.Text = PLACEHOLDER_TEXT) Then newEntry = True dataArray(idataKey) = dateTime myDoc.SelectContentControlsByTag(cc_dataKey)(1).LockContents = False myDoc.SelectContentControlsByTag(cc_dataKey)(1).Range.Text = dateTime myDoc.SelectContentControlsByTag(cc_dataKey)(1).LockContents = TrueElse newEntry = False dataArray(idataKey) = myDoc.SelectContentControlsByTag(cc_dataKey)(1).Range.TextEnd If'iUserdataArray(iUser) = macroUser'iComputerdataArray(iComputer) = macroComputer'iDatetimedataArray(iDatetime) = dateTime'CompanyNameFulldataArray(CompanyNameFull) = myDoc.SelectContentControlsByTag(customer)(3).Range.Text'CompanyNameShortdataArray(CompanyNameShort) = myDoc.SelectContentControlsByTag(customer)(1).Range.Text'CustomerNumber ... customer IDdataArray(CustomerNumber) = myDoc.SelectContentControlsByTag(customer)(2).Range.Text'ContactNamedataArray(ContactName) = myDoc.SelectContentControlsByTag(contact)(1).Range.Text'ContactPhonedataArray(ContactPhone) = myDoc.SelectContentControlsByTag(contact)(2).Range.Text'ContactEmaildataArray(ContactEmail) = myDoc.SelectContentControlsByTag(contact)(3).Range.Text'ContactFaxdataArray(ContactFax) = myDoc.SelectContentControlsByTag(contact)(4).Range.Text'ShippingAddress1dataArray(ShippingAddress1) = myDoc.SelectContentControlsByTag(address)(4).Range.Text'ShippingAddress2dataArray(ShippingAddress2) = myDoc.SelectContentControlsByTag(address)(5).Range.Text'ShippingCitydataArray(ShippingCity) = myDoc.SelectContentControlsByTag(address)(2).Range.Text'ShippingStatedataArray(ShippingState) = myDoc.SelectContentControlsByTag(address)(1).Range.Text'ShippingZipdataArray(ShippingZip) = myDoc.SelectContentControlsByTag(address)(3).Range.Text'ComplaintDateRecieveddataArray(ComplaintDateRecieved) = myDoc.SelectContentControlsByTag(datereceived)(1).Range.Text'ComplaintModelNumberdataArray(ComplaintModelNumber) = myDoc.SelectContentControlsByTag(device)(2).Range.Text'ComplaintDeviceSNdataArray(ComplaintDeviceSN) = myDoc.SelectContentControlsByTag(device)(1).Range.Text'ComplaintTextdataArray(ComplaintText) = myDoc.SelectContentControlsByTag(complaint)(1).Range.Text'ComplaintCaption1dataArray(ComplaintCaption1) = myDoc.SelectContentControlsByTag(caption)(4).Range.Text'ComplaintCaption2dataArray(ComplaintCaption2) = myDoc.SelectContentControlsByTag(caption)(3).Range.Text'FollowUpTicketNumberdataArray(FollowUpTicketNumber) = myDoc.SelectContentControlsByTag(followup)(1).Range.Text'FollowUpCode1dataArray(FollowUpCode1) = myDoc.SelectContentControlsByTag(codes)(1).Range.Text'FollowUpCode2dataArray(FollowUpCode2) = myDoc.SelectContentControlsByTag(codes)(2).Range.Text'FollowUpCode3dataArray(FollowUpCode3) = myDoc.SelectContentControlsByTag(codes)(3).Range.Text'FollowUpNotesdataArray(FollowUpNotes) = myDoc.SelectContentControlsByTag(followup)(2).Range.Text'FollowUpCaption1dataArray(FollowUpCaption1) = myDoc.SelectContentControlsByTag(caption)(1).Range.Text'FollowUpCaption2dataArray(FollowUpCaption2) = myDoc.SelectContentControlsByTag(caption)(2).Range.Text
'Update status barApplication.StatusBar = "Updating log ..."
Dim myLocalBaseFullPath As StringmyLocalBaseFullPath = myDoc.AttachedTemplate.Path & "\LocalBase.xlsx"
Dim excelApp As Excel.ApplicationDim dataWB As Excel.WorkbookDim dataSheet As Excel.WorksheetDim logSheet As Excel.Worksheet
'Launch excel applicationSet excelApp = New Excel.Application
'Open data workbookSet dataWB = excelApp.Workbooks.Open(filename:=myLocalBaseFullPath)Set dataSheet = dataWB.Worksheets("data")
'Unprotect the logdataSheet.Unprotect (MY_PASSWORD)
'Get entry row indexIf (newEntry) Then rowIndex = dataSheet.UsedRange.Rows.Count + 1 dataArray(dataRow) = rowIndexElse For rowIndexFinder = 2 To dataSheet.UsedRange.Rows.Count Application.StatusBar = "Searching through records ... " & rowIndexFinder & " of " & dataSheet.UsedRange.Rows.Count If (dataArray(idataKey) = dataSheet.Cells(rowIndexFinder, 2).Value) Then rowIndex = rowIndexFinder rowIndexFinder = dataSheet.UsedRange.Rows.Count End If NextEnd If
'Log the entrydataSheet.Cells(rowIndex, 1).Value = rowIndexDim colIndex As LongFor colIndex = 1 To DATA_ARRAY_LENGTHApplication.StatusBar = "Updating record ... field " & colIndex & " of " & DATA_ARRAY_LENGTHdataSheet.Cells(rowIndex, colIndex + 1).Value = dataArray(colIndex)Next
''Protect the log'dataSheet.Protect (MY_PASSWORD)
'Close logdataWB.Close SaveChanges:=True
'Release object referencesSet logSheet = NothingSet dataSheet = NothingSet dataWB = NothingSet excelApp = Nothing
'Clear status barApplication.StatusBar = ""End Sub
Sub deleteData()'Nolan Manteufel'24JUL2020
Application.StatusBar = "Deleting data..."
'VariablesDim myDoc As DocumentSet myDoc = ActiveDocument
'temporaryDoc templateDim temporaryDocTemplate As StringtemporaryDocTemplate = myDoc.AttachedTemplate.FullName
Dim temporaryDoc As DocumentSet temporaryDoc = Documents.Add(temporaryDocTemplate)
Dim deleteDoc As StringdeleteDoc = myDoc.FullName'MsgBox deleteDOC
Dim datakey As Stringdatakey = myDoc.SelectContentControlsByTag(cc_dataKey)(1).Range.Text
Dim rowIndexFinder As LongDim rowIndex As Long
'UserDim macroUser As StringmacroUser = Environ$("username")macroUser = LCase(macroUser)
'ComputerDim macroComputer As StringmacroComputer = Environ$("computername")macroComputer = LCase(macroComputer)
'DatetimeDim timeOnly As StringDim dateOnly As StringDim dateTime As StringtimeOnly = Format(Time, "hhmmss")dateOnly = Format(Date, "yyyymmdd")dateTime = dateOnly & timeOnly
Dim myLocalBaseFullPath As StringmyLocalBaseFullPath = myDoc.AttachedTemplate.Path & "\LocalBase.xlsx"
Dim excelApp As Excel.ApplicationDim dataWB As Excel.WorkbookDim dataSheet As Excel.WorksheetDim logSheet As Excel.Worksheet
'Launch excel applicationSet excelApp = New Excel.Application
'Open data workbookSet dataWB = excelApp.Workbooks.Open(filename:=myLocalBaseFullPath)Set dataSheet = dataWB.Worksheets("data")
'Unprotect the logdataSheet.Unprotect (MY_PASSWORD)
'Get entry rowIndexFor rowIndexFinder = 2 To dataSheet.UsedRange.Rows.Count Application.StatusBar = "Searching through records ... " & rowIndexFinder & " of " & dataSheet.UsedRange.Rows.Count If (datakey = dataSheet.Cells(rowIndexFinder, 2).Value) Then rowIndex = rowIndexFinder rowIndexFinder = dataSheet.UsedRange.Rows.Count End IfNext
'Delete the rowdataSheet.Rows(rowIndex).Delete
'Renumber the rowIndex columnFor rowIndex = 2 To dataSheet.UsedRange.Rows.CountdataSheet.Cells(rowIndex, 1).Value = rowIndexNext
''Protect the log'dataSheet.Protect (MY_PASSWORD)
'Close logdataWB.Close SaveChanges:=True
'Release object referencesSet logSheet = NothingSet dataSheet = NothingSet dataWB = NothingSet excelApp = Nothing
'Delete word documentmyDoc.Close SaveChanges:=FalseKill deleteDoc
'Close temporary documentIf (Word.Application.Documents.Count = 1) Then Word.Application.Quit SaveChanges:=wdDoNotSaveChangesElse temporaryDoc.Close SaveChanges:=FalseEnd IfEnd Sub
'Sub validID()''Nolan Manteufel''24JUL2020''Use to check INVALID_CUSTOMER_ID constant'MsgBox validCustomerID'End Sub
Function validCustomerID() As Boolean'Nolan Manteufel'23JUL2020
Dim customerID As StringcustomerID = ActiveDocument.SelectContentControlsByTag(customer)(2).Range.Text
If (customerID = INVALID_CUSTOMER_ID) Then validCustomerID = FalseElse validCustomerID = TrueEnd IfEnd Function
Sub savePDF()'Nolan Manteufel'23JUL2020
Application.StatusBar = "Saving PDF..."
'UserDim macroUser As StringmacroUser = Environ$("username")macroUser = LCase(macroUser)
'ComputerDim macroComputer As StringmacroComputer = Environ$("computername")macroComputer = LCase(macroComputer)
'DatetimeDim timeOnly As StringDim dateOnly As StringDim dateTime As StringtimeOnly = Format(Time, "hhmmss")dateOnly = Format(Date, "yyyymmdd")dateTime = dateOnly & timeOnly
Dim myDoc As DocumentSet myDoc = ActiveDocument
'Customer IDDim customerID As StringcustomerID = myDoc.SelectContentControlsByTag(customer)(2).Range.Text
'PDF filenameDim PDFFILEPATHNAMEEXT As StringPDFFILEPATHNAMEEXT = myDoc.Path & "\PDFs\" & customerID & "_" & dateTime & ".pdf"
'Unlock stamp CCsmyDoc.SelectContentControlsByTag(stamp)(1).LockContents = FalsemyDoc.SelectContentControlsByTag(stamp)(2).LockContents = FalsemyDoc.SelectContentControlsByTag(stamp)(3).LockContents = FalsemyDoc.SelectContentControlsByTag(stamp)(4).LockContents = False
'Set PDF stamp fieldsmyDoc.SelectContentControlsByTag(stamp)(1).Range.Text = macroUsermyDoc.SelectContentControlsByTag(stamp)(2).Range.Text = macroComputermyDoc.SelectContentControlsByTag(stamp)(3).Range.Text = PDFFILEPATHNAMEEXTmyDoc.SelectContentControlsByTag(stamp)(4).Range.Text = dateTime
'Set footer datatime stampmyDoc.SelectContentControlsByTag(datetimestamp)(1).SetPlaceholderText Text:=dateTime
'Save as PDFmyDoc.ExportAsFixedFormat _ OutputFileName:=PDFFILEPATHNAMEEXT, _ ExportFormat:=wdExportFormatPDF, _ OpenAfterExport:=False
'Clear footer datatime stampmyDoc.SelectContentControlsByTag(datetimestamp)(1).SetPlaceholderText Text:=PLACEHOLDER_TEXT
'Clear PDF stamp fieldsmyDoc.SelectContentControlsByTag(stamp)(1).Range.Text = PLACEHOLDER_TEXTmyDoc.SelectContentControlsByTag(stamp)(2).Range.Text = PLACEHOLDER_TEXTmyDoc.SelectContentControlsByTag(stamp)(3).Range.Text = PLACEHOLDER_TEXTmyDoc.SelectContentControlsByTag(stamp)(4).Range.Text = PLACEHOLDER_TEXT
'Lock stamp CCsmyDoc.SelectContentControlsByTag(stamp)(1).LockContents = TruemyDoc.SelectContentControlsByTag(stamp)(2).LockContents = TruemyDoc.SelectContentControlsByTag(stamp)(3).LockContents = TruemyDoc.SelectContentControlsByTag(stamp)(4).LockContents = True
Application.StatusBar = " "End Sub
Private Sub btnSave_Click()'Nolan'23JUL2020
'Set settingsApplication.ScreenUpdating = False
'Set button enablesbtnSave.Enabled = TruebtnSaveAndClose.Enabled = FalsebtnCloseWithoutSaving.Enabled = FalsebtnDelete.Enabled = False
'Require customer IDIf validCustomerID Then saveDoc savePDF saveData 'Reset button enables btnSave.Enabled = True btnSaveAndClose.Enabled = True btnCloseWithoutSaving.Enabled = True btnDelete.Enabled = True 'Save button changes ActiveDocument.Save 'Message user MsgBox ("Congratulations, your document has been saved successfully.")Else 'Reset button enables btnSave.Enabled = True btnSaveAndClose.Enabled = True btnCloseWithoutSaving.Enabled = True btnDelete.Enabled = True 'Message user MsgBox ("Enter a valid customer ID.")End If
'Reset settingsApplication.ScreenUpdating = TrueEnd Sub
Private Sub btnSaveAndClose_Click()'Nolan'23JUL2020
'Set settingsApplication.ScreenUpdating = False
'Set button enablesbtnSave.Enabled = FalsebtnSaveAndClose.Enabled = TruebtnCloseWithoutSaving.Enabled = FalsebtnDelete.Enabled = False
If validCustomerID Then saveDoc savePDF saveData 'Reset button enables btnSave.Enabled = True btnSaveAndClose.Enabled = True btnCloseWithoutSaving.Enabled = True btnDelete.Enabled = True 'Close document If (Application.Documents.Count = 1) Then ActiveDocument.Save Application.Quit Else ActiveDocument.Close SaveChanges:=True End IfElse MsgBox ("Enter a valid customer ID.")End IfEnd Sub
Private Sub btnCloseWithoutSaving_Click()'Nolan'23JUL2020
'Set settingsApplication.ScreenUpdating = False
'Set button enablesbtnSave.Enabled = FalsebtnSaveAndClose.Enabled = FalsebtnCloseWithoutSaving.Enabled = TruebtnDelete.Enabled = False
If validCustomerID Then 'Create PDF savePDF 'Close document If (Application.Documents.Count = 1) Then Application.Quit SaveChanges:=wdDoNotSaveChanges Else ActiveDocument.Close SaveChanges:=False End IfElse MsgBox ("Enter a valid customer ID.")End If
'Reset settingsApplication.ScreenUpdating = TrueEnd Sub
Private Sub btnDelete_Click()'Nolan'23JUL2020
'Set settingsApplication.ScreenUpdating = False
'Set button enablesbtnSave.Enabled = FalsebtnSaveAndClose.Enabled = FalsebtnCloseWithoutSaving.Enabled = FalsebtnDelete.Enabled = True
If validCustomerID Then Dim myDoc As Document Set myDoc = ActiveDocument savePDF deleteDataElse MsgBox ("Enter a valid customer ID.")End IfEnd Sub
'Used to access Content ControlsPrivate Const customer As String = "customer"Private Const contact As String = "contact"Private Const address As String = "address"Private Const datereceived As String = "dateReceived"Private Const device As String = "device"Private Const complaint As String = "complaint"Private Const caption As String = "caption"Private Const followup As String = "followup"Private Const codes As String = "codes"Private Const stamp As String = "stamp"Private Const datetimestamp As String = "datetimeStamp"Private Const picture As String = "picture"Private Const cc_dataKey As String = "datakey"
'Used to set textPrivate Const PLACEHOLDER_TEXT As String = " "Private Const INVALID_CUSTOMER_ID = "N/A"
'Used to move dataPrivate Const DATA_ARRAY_LENGTH As Long = 30
'Used to access data array ... order determines log column orderEnum formInputEnums dataRow idataKey iUser iComputer iDatetime CompanyNameFull CompanyNameShort CustomerNumber ContactName ContactPhone ContactEmail ContactFax ShippingAddress1 ShippingAddress2 ShippingCity ShippingState ShippingZip ComplaintDateRecieved ComplaintModelNumber ComplaintDeviceSN ComplaintText ComplaintCaption1 ComplaintCaption2 FollowUpTicketNumber FollowUpCode1 FollowUpCode2 FollowUpCode3 FollowUpNotes FollowUpCaption1 FollowUpCaption2End Enum
Sub saveDoc()'Nolan Manteufel'23JUL2020
Dim myDoc As DocumentSet myDoc = ActiveDocument
'Doc filenameDim myDocFullPath As StringmyDocFullPath = myDoc.AttachedTemplate.Path
'Autosave document if it is newIf (myDoc.Path = "") Then 'Datetime Dim timeOnly As String Dim dateOnly As String Dim dateTime As String timeOnly = Format(Time, "hhmmss") dateOnly = Format(Date, "yyyymmdd") dateTime = dateOnly & timeOnly 'Customer ID Dim customerID As String customerID = myDoc.SelectContentControlsByTag(customer)(2).Range.Text 'Create path and name for new Word document myDocFullPath = myDocFullPath & "\Entries\" & customerID & "_" & dateTime & ".doc" 'Save new document myDoc.SaveAs2 filename:=myDocFullPathElse myDoc.SaveEnd IfEnd Sub
Sub saveData()'Nolan Manteufel'23JUL2020
Application.StatusBar = "Saving data..."
'VariablesDim myDoc As DocumentSet myDoc = ActiveDocument
Dim dataArray(DATA_ARRAY_LENGTH) As String
Dim datakey As LongDim rowIndexFinder As LongDim rowIndex As Long
'UserDim macroUser As StringmacroUser = Environ$("username")macroUser = LCase(macroUser)
'ComputerDim macroComputer As StringmacroComputer = Environ$("computername")macroComputer = LCase(macroComputer)
'DatetimeDim timeOnly As StringDim dateOnly As StringDim dateTime As StringtimeOnly = Format(Time, "hhmmss")dateOnly = Format(Date, "yyyymmdd")dateTime = dateOnly & timeOnly
'Populate dataArray'dataRow ... leave empty, will be populated with rowIndex'dataKey ... used to locate data recordDim newEntry As BooleanIf (myDoc.SelectContentControlsByTag(cc_dataKey)(1).Range.Text = PLACEHOLDER_TEXT) Then newEntry = True dataArray(idataKey) = dateTime myDoc.SelectContentControlsByTag(cc_dataKey)(1).LockContents = False myDoc.SelectContentControlsByTag(cc_dataKey)(1).Range.Text = dateTime myDoc.SelectContentControlsByTag(cc_dataKey)(1).LockContents = TrueElse newEntry = False dataArray(idataKey) = myDoc.SelectContentControlsByTag(cc_dataKey)(1).Range.TextEnd If'iUserdataArray(iUser) = macroUser'iComputerdataArray(iComputer) = macroComputer'iDatetimedataArray(iDatetime) = dateTime'CompanyNameFulldataArray(CompanyNameFull) = myDoc.SelectContentControlsByTag(customer)(3).Range.Text'CompanyNameShortdataArray(CompanyNameShort) = myDoc.SelectContentControlsByTag(customer)(1).Range.Text'CustomerNumber ... customer IDdataArray(CustomerNumber) = myDoc.SelectContentControlsByTag(customer)(2).Range.Text'ContactNamedataArray(ContactName) = myDoc.SelectContentControlsByTag(contact)(1).Range.Text'ContactPhonedataArray(ContactPhone) = myDoc.SelectContentControlsByTag(contact)(2).Range.Text'ContactEmaildataArray(ContactEmail) = myDoc.SelectContentControlsByTag(contact)(3).Range.Text'ContactFaxdataArray(ContactFax) = myDoc.SelectContentControlsByTag(contact)(4).Range.Text'ShippingAddress1dataArray(ShippingAddress1) = myDoc.SelectContentControlsByTag(address)(4).Range.Text'ShippingAddress2dataArray(ShippingAddress2) = myDoc.SelectContentControlsByTag(address)(5).Range.Text'ShippingCitydataArray(ShippingCity) = myDoc.SelectContentControlsByTag(address)(2).Range.Text'ShippingStatedataArray(ShippingState) = myDoc.SelectContentControlsByTag(address)(1).Range.Text'ShippingZipdataArray(ShippingZip) = myDoc.SelectContentControlsByTag(address)(3).Range.Text'ComplaintDateRecieveddataArray(ComplaintDateRecieved) = myDoc.SelectContentControlsByTag(datereceived)(1).Range.Text'ComplaintModelNumberdataArray(ComplaintModelNumber) = myDoc.SelectContentControlsByTag(device)(2).Range.Text'ComplaintDeviceSNdataArray(ComplaintDeviceSN) = myDoc.SelectContentControlsByTag(device)(1).Range.Text'ComplaintTextdataArray(ComplaintText) = myDoc.SelectContentControlsByTag(complaint)(1).Range.Text'ComplaintCaption1dataArray(ComplaintCaption1) = myDoc.SelectContentControlsByTag(caption)(4).Range.Text'ComplaintCaption2dataArray(ComplaintCaption2) = myDoc.SelectContentControlsByTag(caption)(3).Range.Text'FollowUpTicketNumberdataArray(FollowUpTicketNumber) = myDoc.SelectContentControlsByTag(followup)(1).Range.Text'FollowUpCode1dataArray(FollowUpCode1) = myDoc.SelectContentControlsByTag(codes)(1).Range.Text'FollowUpCode2dataArray(FollowUpCode2) = myDoc.SelectContentControlsByTag(codes)(2).Range.Text'FollowUpCode3dataArray(FollowUpCode3) = myDoc.SelectContentControlsByTag(codes)(3).Range.Text'FollowUpNotesdataArray(FollowUpNotes) = myDoc.SelectContentControlsByTag(followup)(2).Range.Text'FollowUpCaption1dataArray(FollowUpCaption1) = myDoc.SelectContentControlsByTag(caption)(1).Range.Text'FollowUpCaption2dataArray(FollowUpCaption2) = myDoc.SelectContentControlsByTag(caption)(2).Range.Text
'Update status barApplication.StatusBar = "Updating log ..."
Dim myLocalBaseFullPath As StringmyLocalBaseFullPath = myDoc.AttachedTemplate.Path & "\LocalBase.xlsx"
Dim excelApp As Excel.ApplicationDim dataWB As Excel.WorkbookDim dataSheet As Excel.WorksheetDim logSheet As Excel.Worksheet
'Launch excel applicationSet excelApp = New Excel.Application
'Open data workbookSet dataWB = excelApp.Workbooks.Open(filename:=myLocalBaseFullPath)Set dataSheet = dataWB.Worksheets("data")
'Unprotect the logdataSheet.Unprotect (MY_PASSWORD)
'Get entry row indexIf (newEntry) Then rowIndex = dataSheet.UsedRange.Rows.Count + 1 dataArray(dataRow) = rowIndexElse For rowIndexFinder = 2 To dataSheet.UsedRange.Rows.Count Application.StatusBar = "Searching through records ... " & rowIndexFinder & " of " & dataSheet.UsedRange.Rows.Count If (dataArray(idataKey) = dataSheet.Cells(rowIndexFinder, 2).Value) Then rowIndex = rowIndexFinder rowIndexFinder = dataSheet.UsedRange.Rows.Count End If NextEnd If
'Log the entrydataSheet.Cells(rowIndex, 1).Value = rowIndexDim colIndex As LongFor colIndex = 1 To DATA_ARRAY_LENGTHApplication.StatusBar = "Updating record ... field " & colIndex & " of " & DATA_ARRAY_LENGTHdataSheet.Cells(rowIndex, colIndex + 1).Value = dataArray(colIndex)Next
''Protect the log'dataSheet.Protect (MY_PASSWORD)
'Close logdataWB.Close SaveChanges:=True
'Release object referencesSet logSheet = NothingSet dataSheet = NothingSet dataWB = NothingSet excelApp = Nothing
'Clear status barApplication.StatusBar = ""End Sub
Sub deleteData()'Nolan Manteufel'24JUL2020
Application.StatusBar = "Deleting data..."
'VariablesDim myDoc As DocumentSet myDoc = ActiveDocument
'temporaryDoc templateDim temporaryDocTemplate As StringtemporaryDocTemplate = myDoc.AttachedTemplate.FullName
Dim temporaryDoc As DocumentSet temporaryDoc = Documents.Add(temporaryDocTemplate)
Dim deleteDoc As StringdeleteDoc = myDoc.FullName'MsgBox deleteDOC
Dim datakey As Stringdatakey = myDoc.SelectContentControlsByTag(cc_dataKey)(1).Range.Text
Dim rowIndexFinder As LongDim rowIndex As Long
'UserDim macroUser As StringmacroUser = Environ$("username")macroUser = LCase(macroUser)
'ComputerDim macroComputer As StringmacroComputer = Environ$("computername")macroComputer = LCase(macroComputer)
'DatetimeDim timeOnly As StringDim dateOnly As StringDim dateTime As StringtimeOnly = Format(Time, "hhmmss")dateOnly = Format(Date, "yyyymmdd")dateTime = dateOnly & timeOnly
Dim myLocalBaseFullPath As StringmyLocalBaseFullPath = myDoc.AttachedTemplate.Path & "\LocalBase.xlsx"
Dim excelApp As Excel.ApplicationDim dataWB As Excel.WorkbookDim dataSheet As Excel.WorksheetDim logSheet As Excel.Worksheet
'Launch excel applicationSet excelApp = New Excel.Application
'Open data workbookSet dataWB = excelApp.Workbooks.Open(filename:=myLocalBaseFullPath)Set dataSheet = dataWB.Worksheets("data")
'Unprotect the logdataSheet.Unprotect (MY_PASSWORD)
'Get entry rowIndexFor rowIndexFinder = 2 To dataSheet.UsedRange.Rows.Count Application.StatusBar = "Searching through records ... " & rowIndexFinder & " of " & dataSheet.UsedRange.Rows.Count If (datakey = dataSheet.Cells(rowIndexFinder, 2).Value) Then rowIndex = rowIndexFinder rowIndexFinder = dataSheet.UsedRange.Rows.Count End IfNext
'Delete the rowdataSheet.Rows(rowIndex).Delete
'Renumber the rowIndex columnFor rowIndex = 2 To dataSheet.UsedRange.Rows.CountdataSheet.Cells(rowIndex, 1).Value = rowIndexNext
''Protect the log'dataSheet.Protect (MY_PASSWORD)
'Close logdataWB.Close SaveChanges:=True
'Release object referencesSet logSheet = NothingSet dataSheet = NothingSet dataWB = NothingSet excelApp = Nothing
'Delete word documentmyDoc.Close SaveChanges:=FalseKill deleteDoc
'Close temporary documentIf (Word.Application.Documents.Count = 1) Then Word.Application.Quit SaveChanges:=wdDoNotSaveChangesElse temporaryDoc.Close SaveChanges:=FalseEnd IfEnd Sub
'Sub validID()''Nolan Manteufel''24JUL2020''Use to check INVALID_CUSTOMER_ID constant'MsgBox validCustomerID'End Sub
Function validCustomerID() As Boolean'Nolan Manteufel'23JUL2020
Dim customerID As StringcustomerID = ActiveDocument.SelectContentControlsByTag(customer)(2).Range.Text
If (customerID = INVALID_CUSTOMER_ID) Then validCustomerID = FalseElse validCustomerID = TrueEnd IfEnd Function
Sub savePDF()'Nolan Manteufel'23JUL2020
Application.StatusBar = "Saving PDF..."
'UserDim macroUser As StringmacroUser = Environ$("username")macroUser = LCase(macroUser)
'ComputerDim macroComputer As StringmacroComputer = Environ$("computername")macroComputer = LCase(macroComputer)
'DatetimeDim timeOnly As StringDim dateOnly As StringDim dateTime As StringtimeOnly = Format(Time, "hhmmss")dateOnly = Format(Date, "yyyymmdd")dateTime = dateOnly & timeOnly
Dim myDoc As DocumentSet myDoc = ActiveDocument
'Customer IDDim customerID As StringcustomerID = myDoc.SelectContentControlsByTag(customer)(2).Range.Text
'PDF filenameDim PDFFILEPATHNAMEEXT As StringPDFFILEPATHNAMEEXT = myDoc.Path & "\PDFs\" & customerID & "_" & dateTime & ".pdf"
'Unlock stamp CCsmyDoc.SelectContentControlsByTag(stamp)(1).LockContents = FalsemyDoc.SelectContentControlsByTag(stamp)(2).LockContents = FalsemyDoc.SelectContentControlsByTag(stamp)(3).LockContents = FalsemyDoc.SelectContentControlsByTag(stamp)(4).LockContents = False
'Set PDF stamp fieldsmyDoc.SelectContentControlsByTag(stamp)(1).Range.Text = macroUsermyDoc.SelectContentControlsByTag(stamp)(2).Range.Text = macroComputermyDoc.SelectContentControlsByTag(stamp)(3).Range.Text = PDFFILEPATHNAMEEXTmyDoc.SelectContentControlsByTag(stamp)(4).Range.Text = dateTime
'Set footer datatime stampmyDoc.SelectContentControlsByTag(datetimestamp)(1).SetPlaceholderText Text:=dateTime
'Save as PDFmyDoc.ExportAsFixedFormat _ OutputFileName:=PDFFILEPATHNAMEEXT, _ ExportFormat:=wdExportFormatPDF, _ OpenAfterExport:=False
'Clear footer datatime stampmyDoc.SelectContentControlsByTag(datetimestamp)(1).SetPlaceholderText Text:=PLACEHOLDER_TEXT
'Clear PDF stamp fieldsmyDoc.SelectContentControlsByTag(stamp)(1).Range.Text = PLACEHOLDER_TEXTmyDoc.SelectContentControlsByTag(stamp)(2).Range.Text = PLACEHOLDER_TEXTmyDoc.SelectContentControlsByTag(stamp)(3).Range.Text = PLACEHOLDER_TEXTmyDoc.SelectContentControlsByTag(stamp)(4).Range.Text = PLACEHOLDER_TEXT
'Lock stamp CCsmyDoc.SelectContentControlsByTag(stamp)(1).LockContents = TruemyDoc.SelectContentControlsByTag(stamp)(2).LockContents = TruemyDoc.SelectContentControlsByTag(stamp)(3).LockContents = TruemyDoc.SelectContentControlsByTag(stamp)(4).LockContents = True
Application.StatusBar = " "End Sub
Private Sub btnSave_Click()'Nolan'23JUL2020
'Set settingsApplication.ScreenUpdating = False
'Set button enablesbtnSave.Enabled = TruebtnSaveAndClose.Enabled = FalsebtnCloseWithoutSaving.Enabled = FalsebtnDelete.Enabled = False
'Require customer IDIf validCustomerID Then saveDoc savePDF saveData 'Reset button enables btnSave.Enabled = True btnSaveAndClose.Enabled = True btnCloseWithoutSaving.Enabled = True btnDelete.Enabled = True 'Save button changes ActiveDocument.Save 'Message user MsgBox ("Congratulations, your document has been saved successfully.")Else 'Reset button enables btnSave.Enabled = True btnSaveAndClose.Enabled = True btnCloseWithoutSaving.Enabled = True btnDelete.Enabled = True 'Message user MsgBox ("Enter a valid customer ID.")End If
'Reset settingsApplication.ScreenUpdating = TrueEnd Sub
Private Sub btnSaveAndClose_Click()'Nolan'23JUL2020
'Set settingsApplication.ScreenUpdating = False
'Set button enablesbtnSave.Enabled = FalsebtnSaveAndClose.Enabled = TruebtnCloseWithoutSaving.Enabled = FalsebtnDelete.Enabled = False
If validCustomerID Then saveDoc savePDF saveData 'Reset button enables btnSave.Enabled = True btnSaveAndClose.Enabled = True btnCloseWithoutSaving.Enabled = True btnDelete.Enabled = True 'Close document If (Application.Documents.Count = 1) Then ActiveDocument.Save Application.Quit Else ActiveDocument.Close SaveChanges:=True End IfElse MsgBox ("Enter a valid customer ID.")End IfEnd Sub
Private Sub btnCloseWithoutSaving_Click()'Nolan'23JUL2020
'Set settingsApplication.ScreenUpdating = False
'Set button enablesbtnSave.Enabled = FalsebtnSaveAndClose.Enabled = FalsebtnCloseWithoutSaving.Enabled = TruebtnDelete.Enabled = False
If validCustomerID Then 'Create PDF savePDF 'Close document If (Application.Documents.Count = 1) Then Application.Quit SaveChanges:=wdDoNotSaveChanges Else ActiveDocument.Close SaveChanges:=False End IfElse MsgBox ("Enter a valid customer ID.")End If
'Reset settingsApplication.ScreenUpdating = TrueEnd Sub
Private Sub btnDelete_Click()'Nolan'23JUL2020
'Set settingsApplication.ScreenUpdating = False
'Set button enablesbtnSave.Enabled = FalsebtnSaveAndClose.Enabled = FalsebtnCloseWithoutSaving.Enabled = FalsebtnDelete.Enabled = True
If validCustomerID Then Dim myDoc As Document Set myDoc = ActiveDocument savePDF deleteDataElse MsgBox ("Enter a valid customer ID.")End IfEnd Sub
Setup on USB Drive
Setup on USB Drive
This will work from local drives, usb drives and file share servers.
Page updated
Google Sites
Report abuse