I'm currently studying the signature object (Word). This example will test to make sure that the digital signature that the user selects meets certain criteria, or else delete it. However, the sig.delete will prompt the user. Is there anyway to delete the signature object without prompt?
This example is from Microsoft Docs
Function AddSignature(ByVal strIssuer As String, strSigner As String) As Boolean
On Error GoTo Error_Handler
Dim sig As Signature
'Display the dialog box that lets the
'user select a digital signature.
'If the user selects a signature, then
'it is added to the Signatures
'collection. If the user does not, then
'an error is returned.
Set sig = ActiveDocument.Signatures.Add
'Test several properties before commiting the Signature object to disk.
If sig.Issuer = strIssuer And _
sig.Signer = strSigner And _
sig.IsCertificateExpired = False And _
sig.IsCertificateRevoked = False And _
sig.IsValid = True Then
MsgBox "Signed"
AddSignature = True
'Otherwise, remove the Signature object from the SignatureSet collection.
Else
sig.Delete
MsgBox "Not signed"
AddSignature = False
End If
'Commit all signatures in the SignatureSet collection to the disk.
ActiveDocument.Signatures.Commit
Exit Function
Error_Handler:
AddSignature = False
MsgBox "Action canceled."
End Function
Related
I am creating a Word template that performs a bunch of actions when Document_New is initialised. For example, I am pulling in and applying Custom Document Properties from an XML file in one sub, and referring to them in a second.
I'm trying to add some error handling to close the document with an error message and prevent the rest of the VBA from running, and I can get to the point where the document closes, but the rest of the VBA code continues to execute. Ideally I need to close just this new document (other Word documents may be open on a device) and stop any more processing of VBA.
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
When this is in place, the template seems to close, but the newly created document still exists and the template VBA continues to run.
Is anyone able to suggest a way to close the template and abort the creation of the new document?
EDIT: Including an example of how I'm looking for errors.
In Document_New - I call ValidateProperties that loops through an arrayProps array that stores properties required for the template. Each property in the array is checked using the function CustomDocumentPropertyExists and if that returns false I call the sub ExitFailedValidation. This is the sub I want to call if the template fails a validation test. I want to be able to cleanly close the new document without saving and leave any other Word windows open.
Sub ValidateProperties()
Dim arrayProps(1) As String
Dim i As Long
arrayProps(0) = "prop-doc-blueprint"
arrayProps(1) = "prop-doc-stationery"
For i = 0 To UBound(arrayProps)
If CustomDocumentPropertyExists(arrayProps(i)) = False Then
ExitFailedValidation ("The required custom document property " & arrayProps(i) & " is missing. Please check " & _
"the config.xml file to ensure it is included.")
End If
Next i
End Sub
Sub ExitFailedValidation(Message As String)
MsgBox "The Template failed to load and validate." & vbCrLf & vbCrLf & _
Message, vbCritical, "Error loading template"
MsgBox ThisDocument.Name
MsgBox ActiveDocument.Name
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
The Document_New() is the entrance point in code, so it should handle the tasks that need to be run and take appropriate action should an error occurs or something did not go as expected as in your case.
In order to be able to do that, the tasks it calls must report their status, e.g. completed, failed, something is missing etc.
Therefore, change the ValidateProperties() sub into a function that returns true or false and pass a string to it as an output parameter that will hold the error message if the function fails. If all goes well, it will simply be unused.
The main point of the app. This method decides what happens in the app.
Private Sub Document_New()
Dim errorMessage As String
If Not TryValidateProperties(errorMessage) Then
ExitFailedValidation errorMessage
Exit Sub
End If
'all good - continue
End Sub
The ValidateProperties() sub changed to a method that returns true or false with an optional error message if something is wrong. Since false is the default value of a boolean, exiting the function if a property doesn't exist will return false - no need to set it explicitly.
Private Function TryValidateProperties(ByRef outMessage As String) As Boolean
'...
For i = 0 To UBound(arrayProps)
If Not CustomDocumentPropertyExists(arrayProps(i)) Then
outMessage = "The required custom document property " & arrayProps(i) & " is missing. Please check " & _
"the config.xml file to ensure it is included."
Exit Function
End If
Next i
'all good
TryValidateProperties = True
End Function
Lastly, the helper method for communicating the error. In my opinion, the document shouldn't be closed here, but within the Document_New() method if property validation fails, but I'll leave this with you.
Private Sub ExitFailedValidation(Message As String)
MsgBox Message
End Sub
To add error handling in a method:
Sub T()
On Error GoTo Trap
'main method body
Leave:
'Release any references here, e.g. close db connection, release file handle etc.
Exit Sub
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
I have been trying to get this to work but I do not see the issue with it.
My form is called "Request_Order" and the Yes/No checkbox is called "Processed"
Private Sub MarkProcessedOrig_Click()
Const cstrPrompt As String = _
"Are you sure you want to mark this request as processed? Yes/No"
If MsgBox(cstrPrompt, vbQuestion + vbYesNo) = vbYes Then
Request_Order.Controls(Processed).Value = True
Else: Cancel = True
End If
End Sub
Your syntax is wrong. Collection elements are identified by the name of the element, which is a string, or by the offset, which is an integer. So you need to do this:
Request_Order.Controls("Processed").Value = True
The error you're getting is that the VBA runtime can't parse your statement as an object, because your code is saying that there's a variable called Processed that evaluates to a string, and that that variable is a assigned a string value that is the name of one of the controls in your collection. Since that isn't true, you get this error.
Need to delete ‘Request_Order’, this is not necessary, it will run successfully after deletion.
Please try the code below:
Private Sub CommandButton1_Click()
Const cstrPrompt As String = _
"Aref'jei you sure you want to mark this request as processed? Yes/No"
If MsgBox(cstrPrompt, vbQuestion + vbYesNo) = vbYes Then
Controls("CheckBox1").Value = True
Else: Cancel = True
End If
End Sub
I'm hoping somebody can help me with this. I'm creating a model in Excel using VBA and want to populate the Save As dialog with a custom filename. I have three pieces of code. The first is for a userform that asks the end-user to enter the name of their facility:
Private Sub cmdNext_Click()
strHospName = frmHospName.txtHospName.Value
' Check for a usable hospital name
If Len(strHospName) = 0 Then
frmHospName.Hide
MsgBox "Please provide the name of your facility.", vbCritical + vbOKOnly, "Missing Facility Name"
frmHospName.Show
End If
If (Len(strHospName) - Len(Trim(strHospName)) = Len(strHospName)) Then
frmHospName.Hide
MsgBox "Please provide the name of your facility.", vbCritical + vbOKOnly, "Missing Facility Name"
frmHospName.Show
End If
If strHospName Like "*[\/:*?""<>|]*" Then
frmHospName.Hide
MsgBox "Please enter your facility's name without any of the following characters: \ / : * ? < > | ", vbCritical + vbOKOnly, "Invalid Facility Name"
frmHospName.Show
End If
Call SaveAsNameStore(strHospName, MyName)
Set currForm = Me
Unload Me
End Sub
The second piece lives in its own module and checks to see if this model has already been customized (a customized model will not see frmHospName upon workbook open, thus strHospName will not get assigned), and based on that check, it creates the string SaveAsName:
Public strHospName As String
Public SaveAsName As String
Function MyName() As String
MyName = ThisWorkbook.Name
End Function
Sub SaveAsNameStore(strHospName As String, MyName As String)
' This code creates a custom SaveAs name
Dim strModelDate As String
strModelDate = Format(Now, "mm-dd-yyyy")
If (Len(strHospName) - Len(Trim(strHospName)) = Len(strHospName)) Then
SaveAsName = MyName
Else
SaveAsName = strHospName & " customized economic model " & strModelDate
End If
End Sub
The third piece lives in ThisWorkbook and applies SaveAsName in Workbook_BeforeSave:
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
''This code forces SaveAs with custom filename instead of Save to prevent overwriting the master model file
''NEED TO UNCOMMENT PRIOR TO DELIVERY
Application.ScreenUpdating = False
If SaveAsUI = False Then
Cancel = True
ElseIf SaveAsUI = True Then
With Application.FileDialog(msoFileDialogSaveAs)
Application.EnableEvents = False
If .Show Then
ThisWorkbook.SaveAs Filename = SaveAsName
End If
Application.EnableEvents = True
End With
Cancel = True
End If
End Sub
The problem is that, when I click the "Save As" button, the custom SaveAs name isn't populating in the dialog. I can see that SaveAsName is generated correctly via ?SaveAsName in the Immediate window. For syntax, I've tried both ThisWorkbook.SaveAs Filename = SaveAsName and ThisWorkbook.SaveAs Filename:=SaveAsName with the same result both times.
Sorry for the long-winded post. I would appreciate any help you can provide!
This is something I use to make a backup of something I'm currently working in, without naming it the same thing. Easily modified for your situation and variables
Private Sub cmdBackupButton_Click()
'__BACKUP THE CURRENT WORKBOOK___
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs "C:\WhateverPathYouWant\myFile_backup.xlsb")
Application.DisplayAlerts = True
End Sub
This eliminates any "save as" dialogue, and needs no interaction. Very simple.
I want to put a password on the files so no one can open without their permission
It appears the short answer is not unless you have password protection for zip files.
You can however test some vba code and play with visibility. It won't guarantee security of your document because Visio doesn't have flexibility to save as a Macro-Enabled drawing... limiting your ability to really secure it with VBA.
You could however pique the confusion of the undesired user reading/viewing by having all of your pages hidden... Security by obscurity if you will.... Unless they enable macros, they can still ideally do anything they want with the document which Is why you should use encrypted zip software and password protect the document that way.
Anyway... if you're still game for this crazy experiment I tried...
Enabled developer view. Then go into View Code. So here's how this works... First you need to generate your password hash. Then once your password hash is created... Delete the entire
Copy all the main sub, the temporary sub, and the core subs and functions below to your "ThisDocument" object in the developer > View Code page
Set your password by entering your password in place of "Mypassword" in the GenMyPwd sub. You can execute it by leaving your curser in the text of that sub and clicking the "run" button at the top of the Microsoft Visual Basic for Applications menu.
Once you see the pop-up, press Ctrl+V and paste the content to notepad. You'll get something to this effect.
---------------------------
Your Password Hash
---------------------------
78F56C460A6CA4B15554E5FE5469AA036FB21EFA7151E991D6F9A9FDA4548F79
---------------------------
OK
---------------------------
Once you have your hash, set the variable in the private for your own unique hash value.
mypassword = "78F56C460A6CA4B15554E5FE5469AA036FB21EFA7151E991D6F9A9FDA4548F79"
One caveat though, you'll have to create a button for your HidePages Script... or create a key-capture event for a hotkey combination and use it add some additional vba code to Save, HidePages, and then close visio.
Main Sub to capture open document event. - Will look like this before you set your variable
Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
Unauthenticated = True
myPassword = ""
Do While Unauthenticated
'Add number of tries
tries = tries + 1
'Prompt Password
TryPassword = InputBox("Enter the password", "Password Required!")
'Hash Password attempt and compare to Current Hash
If Sha256Hash(TryPassword) = myPassword Then
'Escape the loop
Unauthenticated = False
Call ShowPages
Else
If ((tries > 2) And (Unauthenticated = True)) Then KillVisio
End If
Loop
End Sub
Main Sub After you set your variable
Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
Unauthenticated = True
myPassword = "6DA6F219DAC977DA75F2F2894F33ABAD5052AF2A60AE9219AF0E302EDDD5BBC4"
Do While Unauthenticated
'Add number of tries
tries = tries + 1
'Prompt Password
TryPassword = InputBox("Enter the password", "Password Required!")
'Hash Password attempt and compare to Current Hash
If Sha256Hash(TryPassword) = myPassword Then
'Escape the loop
Unauthenticated = False
Call ShowPages
Else
If ((tries > 2) And (Unauthenticated = True)) Then KillVisio
End If
Loop
End Sub
Additional Required Subs and functions
Sub KillVisio()
Set WShshell = CreateObject("WScript.Shell")
strcommand = "C:\windows\system32\taskkill /im visio.exe -f"
WShshell.Run ("cmd /c " & strcommand)
End Sub
Sub GenMyPwd()
MsgBox Sha256Hash("P#ssw0rd"), vbExclamation, "Your Password Hash"
End Sub
Sub ShowPages()
Set vPages = ThisDocument.Pages
For i = 1 To vPages.Count
Set Visibility = vPages(i).PageSheet.CellsU("UIVisibility")
If Visibility = 1 Then
Visibility.FormulaU = 0
End If
Next
End Sub
Sub HidePages()
Set vPages = ThisDocument.Pages
For i = 1 To vPages.Count
Set Visibility = vPages(i).PageSheet.CellsU("UIVisibility")
If Visibility = 0 Then
Visibility.FormulaU = 1
End If
Next
End Sub
Function Sha256Hash(str)
Dim b() As Byte
b = str
Sha256Hash = BytesToHex(Sha256HashBytes(b))
End Function
Function MD5HashBytes(aBytes)
Set objsha256 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
s = objsha256.Initialize()
MD5HashBytes = objsha256.ComputeHash_2((aBytes))
End Function
Function Sha256HashBytes(aBytes)
'Set objsha256 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
Set objsha256 = CreateObject("System.Security.Cryptography.SHA256Managed")
With objsha256
s = .Initialize()
Sha256HashBytes = .ComputeHash_2((aBytes))
End With
End Function
Function StringtoUTFBytes(aString)
Set UTF8 = CreateObject("System.Text.UTF8Encoding")
StringtoUTFBytes = UTF8.GetBytes_4(aString)
End Function
Function BytesToHex(aBytes)
For x = 1 To LenB(aBytes)
hexStr = Hex(AscB(MidB((aBytes), x, 1)))
If Len(hexStr) = 1 Then hexStr = "0" & hexStr
BytesToHex = BytesToHex & hexStr
Next
End Function
Visio 2016 includes Rights Management support. This feature basically allows you to protect the document and specify who can do what with that document.
Maybe that is what you are after?
I'm trying to create a finance database that requires users to sign in and log out. I have that part working correctly. On the homepage of the database, I'm trying to get their last 25 (or X number) of transactions to display using a query. For some reason, I cannot get the code to pass as it shows a "Data type mismatch." Here is the various code - I'll explain each as I go:
Global Variables (My Global Module)
Option Compare Database
'global variables
Global C As Long
Global C2 As Long
Global HoldString As String
Global Flag As Boolean
Global Reply As String
Global mbReply As VbMsgBoxResult
Global User As String
Global GUser As Long
Global db As Database
The following are the Subs() to Log In (First Sub() is for Exit button, second sub() is for sign in button):
Option Compare Database
Private Sub B_Exit_Click()
mbReply = MsgBox(title:="Exit", _
prompt:="Are you sure you wish to exit the system?", _
Buttons:=vbYesNo)
If mbReply = vbNo Then
Exit Sub
Else
DoCmd.Quit acQuitSaveNone
End If
End Sub
Private Sub B_SignIn_Click()
'variables
Set db = CurrentDb()
Dim Employees As DAO.Recordset
Set Employees = db.OpenRecordset("Employees", dbOpenDynaset)
Dim isEmployeed As Boolean
Dim PassMatch As Boolean
Dim isTerm As Boolean
'check to see if the user is in the system
isEmployeed = False
PassMatch = False
isTerm = False
Do While Not Employees.EOF
If Employees![UserName] = T_Username.Value Then
isEmployeed = True
'make sure the employee is not terminated
If Employees![Terminated] = "Yes" Then
isTerm = True
End If
If isTerm = True Then
MsgBox ("This user has been terminated.")
Exit Sub
End If
'make sure password is correct
If Employees![Password] = T_Password.Value Then
PassMatch = True
End If
If PassMatch = False Then
MsgBox ("Incorrect Password.")
Exit Sub
End If
'mark signed in
Employees.Edit
Employees![SignedIn] = 1
Employees.Update
User = Employees![FirstName] & " " & Employees![LastName]
GUser = Employees![ID] 'Sets GUswer to equal record ID.
End If
Employees.MoveNext
Loop
If isEmployeed = False Then
MsgBox ("This username is not in the system.")
Exit Sub
End If
'close this form and open the main menu
Employees.Close
DoCmd.OpenForm FormName:="HomePage"
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
The next is my SQL code for the query:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter, Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total, Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend
WHERE (((Spend.[EnteredBy])="GUser"));
Spend.[EnteredBy] has a relationship with the Employees table. So EnteredBy is actually a number field because of this relationship.
If I hardcode the "WHERE" statement to be something like (((Spend.[EnteredBy])=2)); then the query will work fine.
Ultimately, what I want to happen is for the query to show the last 25 data entries that the logged on user completed.
Hope this makes sense. If there are questions, please let me know. I feel like I'm missing something small but I cannot figure it out.
Thanks,
Clark
Your query should read:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter,
Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total,
Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend WHERE (((Spend.[EnteredBy])=" & GUser & "));
Note the Ampersands ( & ) I placed before and after your GUser variable. This tells Access to evalute that expression and return the VALUE of it.
I'd also caution you against use the name "User" as a variable name. It's a Reserved Word in Access:
http://office.microsoft.com/en-us/access-help/access-2007-reserved-words-and-symbols-HA010030643.aspx