PDA

View Full Version : Close Workbook Only if Completed



winxmun
05-26-2014, 12:30 AM
Hi All, I was browsing through the thread to find VBA for stopping Users from closing workbook when the range that I specified is blank. Then i saw this thread (http://www.vbaexpress.com/forum/showthread.php?23232-Solved-Restrict-user-to-close-the-file-if-a-cell-is-blank) and it work perfectly fine for me. However how can i save the file without filling up the blank as i meant to restrict other user and not myself. Thanks in advance!

EirikDaude
05-26-2014, 12:58 AM
I think I modified this code from this kb article on Microsoft's homepages (http://support.microsoft.com/kb/161394).

' Declare for call to mpr.dll.
Declare Function WNetGetUser Lib "mpr.dll" _
Alias "WNetGetUserA" (ByVal lpName As String, _
ByVal lpUserName As String, lpnLength As Long) As Long

Const NoError = 0 'The Function call was successful

Function currentUser() As String

' Buffer size for the return string.
Const lpnLength As Integer = 255
' Get return buffer space.
Dim status As Integer
' For getting user information.
Dim lpName As String

' Assign the buffer size constant to lpUserName.
currentUser = Space$(lpnLength + 1)

' Get the log-on name of the person using product.
status = WNetGetUser(lpName, currentUser, lpnLength)

' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
currentUser = Left$(currentUser, InStr(currentUser, Chr(0)) - 1)
Else
' An error occurred.
MsgBox "Unable to get the name."
End
End If
End Function

Then modify the if-clause at the end of xld's code:

if msg <> "" or currentUser = myUsername then

Bob Phillips
05-26-2014, 01:45 AM
You can do it simply with



Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim msg As String
Dim i As Long

With Worksheets("Action item tracker")

For i = 2 To .Cells(.Rows.Count, "F").End(xlUp).Row

If .Cells(i, "F").Value <> "" And .Cells(i, "H").Value = "" Then

msg = msg & "Row #" & i & vbNewLine
End If
Next i

If msg <> "" Or Environ("Username") = "myloginname" Then

MsgBox "Incomplete data" & vbNewLine & vbNewLine & msg
Cancel = True
End If
End With
End Sub

EirikDaude
05-26-2014, 01:51 AM
Hah, it seems someone is better at keeping up with new VBA-functions than I am :) Thanks for showing the easier way, xld!