Sleeper: Problem while running protected macro

[Krishna Kumar]

Hi All,

I got the following error when I run a protected macro.

Run TIme Error 1004
Method 'SaveAs' of object '_Workbook' failed.

If I run this macro after unlocking then there is no problem.

Any ideas?

Thanks

[Philcjr]

Krishna,

Any chance of you posting your code?

Phil

[lucas]

Krishna,
Not sure if your talking about sheet protection or not but take a look at this thread.

 http://www.vbaexpress.com/forum/showthread.php?t=3950&highlight=protected

[Krishna Kumar]

Hi Phil,

Here is the code..

I'm a novice in VBA. So the code is not look a good one.

Sub MakeTxtFile()
Dim OrgRange		As Range
Dim LastRow		 As Long
Dim FilterRng	   As Range
Dim FilterRow	   As Long
Dim Shft			As String
Dim pDate		   As Date
Dim UnionRng		As Range
LastRow = [a65536].End(xlUp).Row
Set OrgRange = Range("A1:H" & LastRow)
	If [i1].Value = "" Then
		MsgBox "Enter Shift in the Activecell"
			[i1].Select
		Exit Sub
	End If
	If [j1].Value = "" Then
		MsgBox "Enter Production Date in the Activecell"
			[j1].Select
		Exit Sub
	End If
Shft = [i1].Value
pDate = [j1].Value
	Application.ScreenUpdating = False
	OrgRange.Sort Key1:=Range("H2"), Order1:=xlDescending, Key2:=Range("G2") _
		, Order2:=xlAscending, Key3:=Range("E2"), Order3:=xlAscending, Header:= _
		xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
FilterRow = [h1].End(xlDown).Row
Set FilterRng = Union(Range("A2:A" & FilterRow), Range("G2:G" & FilterRow), Range("H2:H" & FilterRow))
	FilterRng.Copy
	Sheets("D12250").Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
		False, Transpose:=False
	Application.CutCopyMode = False
	Sheets("D12250").Activate
		ActiveWorkbook.SaveAs Filename:= _
		"C:\Documents and Settings\ricoac\Desktop\101112250 " & Format(Now(), "ddmmyy") & " (" & Shft & ")" & ".txt", FileFormat:=xlText _
		, CreateBackup:=False
	ActiveSheet.Name = "D12250"
		Sheets("InputSheet").Activate
	ActiveWorkbook.SaveAs Filename:="C:\krishnan\KrisFiles\Sap\PaintShop.xls", _
		FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
		ReadOnlyRecommended:=False, CreateBackup:=False
	Range("I2:I" & FilterRow) = Shft
	Range("J2:J" & FilterRow) = pDate
Set UnionRng = Union(Range("C2:C" & FilterRow), Range("F2:F" & FilterRow), Range("H2:J" & FilterRow))
	UnionRng.Copy
	Workbooks.Open Filename:="C:\Documents and Settings\ricoac\Desktop\ps.xls", UpdateLinks:=3
	Sheets("Data").Select
	Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues, _
	Operation:=xlNone, SkipBlanks:=False, Transpose:=False
	ActiveWorkbook.Save
	ActiveWorkbook.Close
	Application.ScreenUpdating = True
End Sub

I'm not sure which line causing problem, because if I run the code after unprotecting then there is no problem at all.

Lucas,
It' not sheet protection.

Thanks,

[geekgirlau]

The message would seem to indicate that it's having trouble saving the file. To confirm this, add a line of code as follows:

Msgbox "Test 1" 
ActiveWorkbook.SaveAs Filename:="C:\krishnan\KrisFiles\Sap\PaintShop.xls", _
  FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
  ReadOnlyRecommended:=False, CreateBackup:=False
Msgbox "Test 2"

Then protect the workbook and run the macro again. If you see the first message but not the second, the "SaveAs" is causing your error. If you see both messages, the error is occuring after this point. If you don't see any messages, the error is occurring before this point.

[Krishna Kumar]

Hi,


I tested with this line and I think ActiveWorkbook.SaveAs.. is causing the problem. Any workaround to overcome this problem.

MsgBox "Test 1"
ActiveWorkbook.SaveAs Filename:= _
		"C:\Documents and Settings\ricoac\Desktop\101112250 " & Format(Now(), "ddmmyy") & " (" & Shft & ")" & ".txt", FileFormat:=xlText _
		, CreateBackup:=False
MsgBox "Test 2"

Then protect the workbook and run the macro again

I didn't protect my workbook. I locked the code for viewing.

HTH