geting built in dialog info

F

filo666

Hi, I want to offer the user the option of protecting the workbook, the think
is I need to save his password and the selections of the protection dialog
box:

Application.Dialogs(28).Show

how to save the password and the:
..AllowDeletingColumns
..AllowDeletingRows
..AllowFiltering
..AllowFormattingCells
..AllowFormattingColumns
..AllowFormattingRows
.AllowInsertingColumns
.AllowInsertingHyperlinks
.AllowInsertingRows
..AllowSorting
..AllowUsingPivotTables

TIA
 
F

filo666

Hi chris, thanks for the input; What I want to do is to protect all the
sheets in my workbook, I have a:

sub protectallsheets()
Application.Dialogs(28).Show
For Each Sht In ActiveWorkbook.Sheets
sht.select
'protect sht with the dialog options and password
'chosen in Application.Dialogs(28).Show
next
end sub

therefore I need to get the variables of the protection dialog (28)
including the password.
 
P

Peter T

Although you can set the options in a dialog before showing it, you can't
read options that user may have changed before hitting the OK button. All
you can do is trap the boolean return which will tell you if user did OK or
Cancel.

For your purposes maybe you could make userform to simulate the dialog, and
trap the password in a textbox.

Alternatively, maybe read the text as user types the password into the
dialog. Should work though not sure without testing how safe it would be as
it would entail running a Timer/AddressOf while the dialog is displayed. If
you want to try that approach I'll put something together.

Regards,
Peter T
 
F

filo666

Hi Peter, thanks fpr your answer, are you completely shure that it is not
possible???
creating my own dialog seems like primitive considering that there is
something already built, if that is what it takes I will go for that option.
I am curious about your idea, how could I accomplish your second sugestion?

thanks
 
P

Peter T

Yes I'm sure. Normally the only way to tell what the user has applied with a
dialog is to compare before & after, assuming it returned True. In the case
of a password of course can't do that directly. Actually it's easy enough to
"crack" but probably wouldn't get the original pw, just another one that
works.

OK, if you're feeling adventurous and don't want to roll your own dialog,
have a go with the following. Note the warning about don't do anything in
the VBE while the Timer is running. Run "Test" and adapt that to your
needs, but ensure sufficient error handling is included to stop the timer if
necessary. Probably better not to fiddle with anything else unless you know
what you are doing.

Option Explicit
' get user entered password from the password dialog
' pmbthornton at gmail com

'' <<< DO NOT BREAK OR EDIT ANY CODE WHILE THE TIMER IS RUNNING >>>

Private Declare Function SetTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA"
( _
ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long

Private Const WM_GETTEXTLENGTH As Long = &HE
Private Const WM_GETTEXT As Long = &HD
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Private Const mcDLGNAME As String = "bosa_sdm_XL9"
Private Const mcPROTSHEET As String = "Protect Sheet"
Private Const mcPWCONF As String = "Confirm Password"
Private Const mcUNPROT As String = "Unprotect Sheet"

Private hTimer As Long
Private msPW As String, msPWconfirm As String, msUnprotPW As String


Sub Test()
Dim bProtContOrig As Boolean, bProtCont As Boolean
Dim s, sMsg As String
Dim bApplied As Boolean
Dim ws As Worksheet

On Error GoTo errH
reTry:

Set ws = ActiveSheet
bProtContOrig = ws.ProtectContents

' msPW = "wrong" ' for testing
If bProtContOrig And Len(msPW) Then
If MsgYN("Try password: " & msPW) Then
On Error Resume Next
ws.Unprotect msPW
If ws.ProtectContents Then
MsgBox msPW & vbCr & "invalid password"
Else
MsgBox "unprotected"
Exit Sub
End If
End If
End If

StartLooking
bApplied = Application.Dialogs(xlDialogProtectDocument).Show
StopLooking

bProtCont = ws.ProtectContents
sMsg = "ProtectContents" & vbCr & _
"before <> now " & vbCr & _
bProtContOrig & " <> " & bProtCont & vbCr & vbCr

If bApplied Then
sMsg = sMsg & "msPW = " & msPW & vbCr & _
"msPWconfirm = " & msPWconfirm & vbCr & _
"msUnprotPW = " & msUnprotPW
Else: sMsg = sMsg & "User cancelled"
End If

MsgBox sMsg

Exit Sub
errH:
s = msUnprotPW
StopLooking
If Err.Number = 1004 And Len(s) Then
If MsgYN(s & vbCr & "Incorrect password, try again ?") Then Resume
reTry
Else
MsgBox Err.Description
End If
End Sub

Function MsgYN(sMsg, Optional sTitle As String) As Boolean
On Error Resume Next
If Len(sTitle) = 0 Then sTitle = Application.Name
MsgYN = MsgBox(sMsg, vbYesNo, sTitle) = vbYes
End Function

Sub StartLooking()
msPW = ""
msPWconfirm = ""
msUnprotPW = " " ' yes a space
StopLooking
hTimer = SetTimer(0&, 0&, 30&, AddressOf TimerLookAtDlg)

End Sub
Sub StopLooking()
If hTimer Then
KillTimer 0, hTimer
hTimer = 0
End If
End Sub

Sub TimerLookAtDlg(ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Dim hWndDlg As Long, hWndEditPW As Long
Dim nSize As Long, nLen As Long, n As Long
Dim sBuff As String * 128, sEditText As String
Static RunCnt As Long

On Error GoTo errH

hWndDlg = FindWindow(mcDLGNAME, vbNullString)

RunCnt = RunCnt + 1
If RunCnt > 1000 Then Err.Raise 12345

If hWndDlg > 0 Then
GetWindowText hWndDlg, sBuff, 128&
If InStr(1, sBuff, mcPROTSHEET) Then
n = 1
ElseIf InStr(1, sBuff, mcPWCONF) Then
n = 2
ElseIf InStr(1, sBuff, mcUNPROT) Then
n = 3
End If

If n Then
RunCnt = 0
hWndEditPW = FindWindowEx(hWndDlg, 0&, "EDTBX", vbNullString)

nSize = SendMessage(hWndEditPW, WM_GETTEXTLENGTH, 0&, ByVal 0&)
+ 1
If nSize > 1 Then
sEditText = String(nSize, 0)
nLen = SendMessage(hWndEditPW, WM_GETTEXT, nSize, ByVal
sEditText)

If nLen Then
sEditText = Left$(sEditText, nLen)
If n = 1 Then
msPW = sEditText
ElseIf n = 2 Then
msPWconfirm = sEditText
ElseIf n = 3 Then
msUnprotPW = sEditText
End If
End If
End If
End If
End If

Exit Sub
errH:
RunCnt = 0
KillTimer 0, hTimer
If Err.Number = 12345 Then
MsgBox "TimerLookAtDlg timed out while PW dialog not found"
Else
MsgBox Err.Number & " " & Err.Description, , "Error in
TimerLookAtDlg"
End If

End Sub

This is only lightly tested but would be interested in feedback.

Regards,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top