hkgal
asked on
fail to update footer in vba automation
I've got a code to handle and update every worksheets of every Excel workbooks in a single folder. It works well with most cases. But if the Excel contains only one sheet, it fails:
Sub Sample()
Dim wb As Workbook, ws As Worksheet
Dim StrFile, pwd As String
Dim msgFooter As String
Dim MyFolder As String
Dim pwdbool As Boolean
'~~> Footer Message
msgFooter = "OFFICAL22"
MyFolder = InputBox("Pls enter the path of folder") & "\"
StrFile = Dir$(MyFolder & "*.xls")
Application.DisplayAlerts = False
Do While Len(StrFile)
pwd = "123"
Set wb = Nothing
On Error Resume Next
Set wb = Workbooks.Open(MyFolder & StrFile, , , , pwd, pwd)
If wb Is Nothing Then
pwd = "abc"
Set wb = Workbooks.Open(MyFolder & StrFile, , , , pwd, pwd)
If wb Is Nothing Then
pwd = "se456"
pwdbool = True
Set wb = Workbooks.Open(MyFolder & StrFile, , , , pwd, pwd)
If wb Is Nothing Then
pwd = "8880011"
pwdbool = True
Set wb = Workbooks.Open(MyFolder & StrFile, , , , pwd, pwd)
If Not wb Is Nothing Then
'~~> Add the relevent Text to the Footer
For Each ws In wb.Worksheets
With ws.PageSetup
.LeftFooter = msgFooter
End With
Next
End If
Else
For Each ws In wb.Worksheets
With ws.PageSetup
.LeftFooter = msgFooter
End With
Next
End If
Else
For Each ws In wb.Worksheets
With ws.PageSetup
.LeftFooter = msgFooter
End With
Next
End If
Else
For Each ws In wb.Worksheets
With ws.PageSetup
.LeftFooter = msgFooter
End With
Next
End If
wb.Close savechanges:=True
StrFile = Dir
Loop
Set ws = Nothing
Set wb = Nothing
End Sub
I can't figure out why...pls help! Thanks!
Sub Sample()
Dim wb As Workbook, ws As Worksheet
Dim StrFile, pwd As String
Dim msgFooter As String
Dim MyFolder As String
Dim pwdbool As Boolean
'~~> Footer Message
msgFooter = "OFFICAL22"
MyFolder = InputBox("Pls enter the path of folder") & "\"
StrFile = Dir$(MyFolder & "*.xls")
Application.DisplayAlerts = False
Do While Len(StrFile)
pwd = "123"
Set wb = Nothing
On Error Resume Next
Set wb = Workbooks.Open(MyFolder & StrFile, , , , pwd, pwd)
If wb Is Nothing Then
pwd = "abc"
Set wb = Workbooks.Open(MyFolder & StrFile, , , , pwd, pwd)
If wb Is Nothing Then
pwd = "se456"
pwdbool = True
Set wb = Workbooks.Open(MyFolder & StrFile, , , , pwd, pwd)
If wb Is Nothing Then
pwd = "8880011"
pwdbool = True
Set wb = Workbooks.Open(MyFolder & StrFile, , , , pwd, pwd)
If Not wb Is Nothing Then
'~~> Add the relevent Text to the Footer
For Each ws In wb.Worksheets
With ws.PageSetup
.LeftFooter = msgFooter
End With
Next
End If
Else
For Each ws In wb.Worksheets
With ws.PageSetup
.LeftFooter = msgFooter
End With
Next
End If
Else
For Each ws In wb.Worksheets
With ws.PageSetup
.LeftFooter = msgFooter
End With
Next
End If
Else
For Each ws In wb.Worksheets
With ws.PageSetup
.LeftFooter = msgFooter
End With
Next
End If
wb.Close savechanges:=True
StrFile = Dir
Loop
Set ws = Nothing
Set wb = Nothing
End Sub
I can't figure out why...pls help! Thanks!
Rory Archibald
Fails where and how? From a quick read through, the only way I can see that failing would be if the workbook had only one sheet and that sheet is not a worksheet (e.g. it's a chart sheet)
In fact, even then, it should just not do anything rather than fail.
ASKER
yes yes sorry, it will by-pass the workbook with only one sheet and didn't update.....I don't know why
What type of sheet is in the workbook? Worksheet or chart?
ASKER
worksheet
If you want to do all sheets regardless of type, then you need to declare ws as Object rather than Worksheet and then use:
For Each ws In wb.SheetsASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I was prompted with "unable to set the leftfooter property for pagesetup class"....
Does the machine on which you are running this have a default printer setup?
Do you get the error on only single sheet workbooks or any workbook with any number of sheets?
Try this: Open a new workbook, put this macro in it, save it, and run the macro.
Public Sub Test()
ThisWorkbook.Sheets(1).Pag
End Sub
Do you get an error? Try it with one only one sheet. Two sheets.
If all of the tests produce the same error then 1) we are dealing with something different than what we started with, and 2) it's probably something to do with your printer driver or how you have defined your printer on that box.
Does the code posted earlier work on other boxes? If so perhaps you can run it there and be done with this task if this is a one time project that you will never have to repeat again.
Kevin
Try this: Open a new workbook, put this macro in it, save it, and run the macro.
Public Sub Test()
ThisWorkbook.Sheets(1).Pag
End Sub
Do you get an error? Try it with one only one sheet. Two sheets.
If all of the tests produce the same error then 1) we are dealing with something different than what we started with, and 2) it's probably something to do with your printer driver or how you have defined your printer on that box.
Does the code posted earlier work on other boxes? If so perhaps you can run it there and be done with this task if this is a one time project that you will never have to repeat again.
Kevin
ASKER
The excel files i encounter error is sent from some other users with landscape orientation and only 1 worksheet in the workbook.
Yes I try to paste the "Sub Test()" code in that excel and it prompted with same error message...
just not sure why it happens..
The code i used before works well with most cases.
Yes I try to paste the "Sub Test()" code in that excel and it prompted with same error message...
just not sure why it happens..
The code i used before works well with most cases.
Did you run the test case on a sample workbook with more than one sheet?
Kevin
Kevin
ASKER
yes the test case works on the first worksheet if the workbook got more than one sheet
ASKER
here's the file sample
singlesheet.xls
singlesheet.xls
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Then how could I incorporate this to my code??
ASKER
oh! I got it! cool man!
ASKER
helpful!
Curious choice of accept vs. assist, IMO, but hey ho.