I need Macro Help

  • Thread starter Thread starter John Kitchens
  • Start date Start date
J

John Kitchens

SORRY FOR THE LENGTH OF THIS POST!

I am having a problem that I hope I can get resolved here.

I created a file that the user fills out and enters the information.
This file is saved in a folder named for example 091604.

There may be up to 60 or 70 files stored in this folder. Tommorrow the same
process different folder etc. 091704.

I have another form that I saved as a template. When you open this form
there is "Click Here" button. When you click this button the open file box
appears and you can highlight the files that you want to summarize.

All worked fine until I tried to summarize more than 34 files. If you do
less than 34 files it works great. When you have more than 34 ( I will have
60 to 70) you get error messages asking for you to debug etc.

I didn't create the macro. I contacted the person that made it and they sent
me a new form. This macro will open the files that I highlight and delete
any objects that are in the files and also change the font to normal.

THE PROBLEM. All of the individual files I am summarizing are protected. So
it will not work either. I did a sample of 60 files that were unprotected
and it worked properly.

I have no option of having the individual files unprotected. They are filled
out by inexperienced users and there is no way that I can unprotect them.

I am including a copy of the macro here:

Sub GetSheets()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim ws As Worksheet
Application.DisplayAlerts = False
varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
Set ws = wkbk.Sheets("Sheet1")
ws.Name = Left(wkbk.Name, Len(wkbk.Name) - 4)
ws.Cells.Style = "Normal"
ws.DrawingObjects.Delete
ws.Copy After:=ThisWorkbook.Worksheets("Start")

wkbk.Close SaveChanges:=False
Next
End If
Application.DisplayAlerts = True
End Sub

Sub UnhideSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
ws.Visible = xlSheetVisible
Next ws
End Sub

Is there a way that this macro can be changed to tell it to unprotect the
individual files.

I love the way this thing works, I just need to be able to do at least 70
files, and it won't do it with the old macro or with this one unless
protection is turned off. The person that made this macro is on vacaton
until next month. I really can't wait that long.

Please help.
 
When you write that the file is protected, what do you mean?

#1. Do you mean that you need to know the password to open the file (at the
File|open prompt if done manually)?

#2. Or do you mean you can open it in readonly mode and do what you want?

#3. Or do you mean the worksheet itself is protected
(Tools|protection|Unprotect sheet, if you're unprotecting it manually)?

If it's #1, then you need to specify the password when you open the workbook.
Set wkbk = Workbooks.Open(varr(i))

If you look at Open in VBA's help, you'll see how to do that. But if the
password changes for each file, it could get messier.

If #2, you can also tell excel to open the workbook in readonly mode. (VBA's
help describes that, too.)

If #3, you either need the password for each sheet or you'll need to break the
password to be able to make changes.

It sounds like the macro you posted is working fine for unprotected (whatever
that means) workbooks.

And finally, it's good to post the version of excel that you're using.
 
Hello Dave,

Thanks for your reply. I am using Excel 2000. I mean number 3 on your list.

The sheet is protected so that only certain cells can be changed. If the
user tries to make a change in a cell that is protected they will get the
standard error message. There is no password applied to it.

To unprotect I do just what you said, Tools|Protection|Unprotect Sheet.

So now that you know what I am up against can you help me?
The macro does work great. It came from one of the regulars at this forum.
This person just happens to be gone until next month, and I am dire need to
have this work now.

I will be glad to e-mail you the files if you would like for me to. Then you
could see exactly what I am doing.

Please help if you can.
 
If there is no password applied to it, then you could unprotect it.

right after this line:
Set ws = wkbk.Sheets("Sheet1")
put this:
ws.unprotect

In fact, you could test to see if the .unprotect were successful:

Option Explicit

Sub GetSheets()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim ws As Worksheet
Application.DisplayAlerts = False
varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
Set ws = wkbk.Sheets("Sheet1")
ws.Unprotect
If ws.ProtectContents _
Or ws.ProtectDrawingObjects _
Or ws.ProtectScenarios Then
MsgBox wkbk.Name & " Has a protected worksheet!"
Else
ws.Name = Left(wkbk.Name, Len(wkbk.Name) - 4)
ws.Cells.Style = "Normal"
ws.DrawingObjects.Delete
ws.Copy After:=ThisWorkbook.Worksheets("Start")
End If
wkbk.Close SaveChanges:=False
Next
End If
Application.DisplayAlerts = True
End Sub

If you don't know the password of the worksheet, J.E. McGimpsey has a utility
that will unprotect the worksheet--it's useful for all the worksheets in one
workbook. I'm not sure I'd run it 30-60 times, though.

http://www.mcgimpsey.com/excel/removepwords.html

But you could rearrange your routine, though.

Instead of doing all the work in the subroutine that copies the worksheet, you
could just copy that worksheet.

Then after you accumulate them into one giant workbook, you could unprotect all
the copied worksheets (using J.E'.s code--just once!). Then use your
Unhidesheets macro to do all the work.

Kind of like this (untested):

Option Explicit
Sub GetSheets()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim ws As Worksheet
Application.Screenupdating = False
varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
Set ws = wkbk.Sheets("Sheet1")
ws.Name = Left(wkbk.Name, Len(wkbk.Name) - 4)
ws.Copy After:=ThisWorkbook.Worksheets("Start")
End If
wkbk.Close SaveChanges:=False
Next
End If
Application.Screenupdating = True
End Sub

Sub UnhideSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
ws.Visible = xlSheetVisible
ws.Cells.Style = "Normal"
ws.DrawingObjects.Delete
Next ws
End Sub

And I changed the .displayalerts to .screenupdating. I bet the orignal author
wanted to hide the screen jumping around.
 
Hello Dave,

You did it!

Adding: ws.unprotect

fixed the macro for me. Thank you so much for all of your help. I am sure
that I will have something else that I need help on very soon.

John Kitchens
 
Back
Top