LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 86
Default Automation Error: Object Disconnected From Clients

After getting a macro to work which reset the passwords for each file in a
user-selected folder and its subfolder, I decided this would be a good
application for using my first Userform.

My previous macro now just loads the userform, and I've moved the code to
buttons on the form. Before, the flow was linear--get the folder to operate
on, validate each piece of data as it was entered, and display a message and
exit if the criteria is not met.

In the new form, I've textboxes for the old and new passwords (2 each), a
default filefolder location, OK and Cancel buttons, and a button to change
the default folder location. The latter is working fine--it writes the user
selection to the textbox.

In the OK button procedure, I'm trying to pick up the textbox value as the
..LookIn property of the FileSearch object, but I'm getting the subject error
message. Can anyone point out where I'm erring?

Thank you for all assistance.

Sprinks

Private Sub cmdChangeFolder_Click()
On Error GoTo ErrHandler

' Dimension variables.
Dim fs As FileSearch
Application.EnableEvents = False

' Declare filesearch object.
Set fs = Application.FileSearch

' Set folder to search.
With fs
.SearchSubFolders = True
.LookIn = GetFolderName() ' See function below
End With

If fs.LookIn = "" Then
GoTo ErrExit
End If

' Set file name to search for.
fs.Filename = "*.xls"

' Execute the file search, and check to see if the file(s) are present.
If fs.Execute 0 Then
With Me![txtFolderName]
.Locked = False
.Value = fs.LookIn
.Locked = True
End With
End If

ErrExit:
Application.EnableEvents = True
Set fs = Nothing
Exit Sub

ErrHandler:
MsgBox "There has been the following error. Please contact the macro "
& _
"administrator." & _
vbCrLf & vbCrLf & Err.Number & vbCrLf & " " & Err.Description
Resume ErrExit


End Sub

Private Sub cmdOK_Click()
' Requires:
' - Function GetFolderName
'On Error GoTo ErrHandler

' Dimension variables.
Dim fs As FileSearch
Dim wb As Workbook
Dim astrParsedName() As String
Dim astrCantOpen() As String
Dim i, j As Integer
Dim strMsg As String

Application.EnableEvents = False

' Declare filesearch object.
Set fs = Application.FileSearch

' Set folder to search, subfolders, and filter
With fs
.LookIn = Me![txtFolderName]
.SearchSubFolders = True
.Filename = ".xls"
End With

If fs.LookIn = "" Then
GoTo ErrExit
End If

' Execute the file search, and check to see if the file(s) are present.
If fs.Execute 0 Then

'Validate data
If Me![txtOPW] < Me![txtOPWV] Then
MsgBox "Old passwords do not match."
Me!txtOPWV = ""
With Me!txtOPW
.Value = ""
.SetFocus
End With
Exit Sub
End If
If Me!txtNPW < Me!txtNPWV Then
Me!txtNPWV = ""
With Me!txtNPW
.Value = ""
.SetFocus
End With
Exit Sub
End If

' Write new password to sheet
ActiveWorkbook.Worksheets("Splash").Activate
With ActiveWorkbook.Worksheets("Macros")
.Unprotect
.Cells(50, 2).Value = Me!txtNPW
End With
With ActiveWorkbook
.Password = Me!txtNPW
.Worksheets("Macros").Protect
.Worksheets("Splash").Visible = True
End With

Application.ScreenUpdating = False

' Loop through all files
j = 0
For i = 1 To fs.FoundFiles.Count
Set wb = Nothing
On Error Resume Next

Set wb = Workbooks.Open _
(Filename:=fs.FoundFiles.Item(i), Password:=Me![txtOPW])
On Error GoTo 0

If wb Is Nothing Then
' File has a different password; write name to astrCantOpen
array
j = j + 1
astrParsedName = Split(fs.FoundFiles.Item(i), "\")
ReDim Preserve astrCantOpen(j)
astrCantOpen(j) = astrParsedName(UBound(astrParsedName))

Else
' If file has a password, change it to the new one
If ((ActiveWorkbook.HasPassword) Or Me![chkBlank]) Then
With ActiveWorkbook
.Password = Me![txtNPW]
.Save
End With
End If
ActiveWorkbook.Close
End If
Next i

On Error GoTo ErrHandler
If j < 0 Then
' Some files couldn't be opened
strMsg = "Couldn't open files: " & vbCrLf & vbCrLf
For i = 1 To UBound(astrCantOpen)
strMsg = strMsg & astrCantOpen(i) & vbCrLf
Next i
strMsg = strMsg & vbCrLf & vbCrLf & "Other passwords set
successfully."
MsgBox strMsg
Else
MsgBox "Password change for all files in: " & vbCrLf & vbCrLf & _
fs.LookIn & vbCrLf & vbCrLf & _
" & its subfolders was successful.", vbOKOnly, "Password Reset
Successful!"

End If
With ActiveWorkbook
.Worksheets(1).Activate
.Worksheets("Splash").Visible = False
.Save
End With

Else
' Display message if no files were found.
MsgBox "No files were found in: " & vbCrLf & vbCrLf & fs.LookIn,
vbOKOnly, "No Files Found!"
End If

ErrExit:
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set fs = Nothing
Set wb = Nothing
Exit Sub

ErrHandler:
MsgBox "There has been the following error. Please contact the macro "
& _
"administrator." & _
vbCrLf & vbCrLf & Err.Number & vbCrLf & " " & Err.Description
Resume ErrExit


End Sub

Function GetFolderName() As Variant
On Error GoTo ErrHandler

Dim fd As FileDialog
Dim vrtSelectedItem As Variant

' Request folder name
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then
GetFolderName = fd.SelectedItems(1)
Else
' the user pressed Cancel
GetFolderName = ""
End If

' Clean up
Set fd = Nothing

ErrExit:
Exit Function

ErrHandler:
MsgBox "There has been the following error. Please contact the macro "
& _
"administrator." & _
vbCrLf & vbCrLf & Err.Number & vbCrLf & " " & Err.Description
Resume ErrExit

End Function
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Automation Error : The Object Invoked Has Disconnected From Its Clients !! [email protected] Excel Programming 3 June 17th 05 01:17 PM
Error using SaveAs (object disconnected from clients!) then XL Cra Philip Excel Programming 1 May 12th 05 12:05 AM
Automation Error: The Object Invoked Has Disconnected from Its Clients (Excel) Vaibhav Excel Programming 0 September 8th 03 04:57 PM
Automation Error: The Object Invoked Has Disconnected from Its Clients Vaibhav Dandavate Excel Programming 0 September 8th 03 04:05 PM


All times are GMT +1. The time now is 03:10 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"