FOoter Looping Program

I have the following Code: and I am getting a Select Case Compilation error that I can't figure out.. I tried adding an "End Select" for my second case.... etc.

Sub MacroUpdateFooter()
'
' MacroUpdateFooter Macro
' Macro recorded 7/28/2006 by Blue2man
'

Dim tmp As String
Dim ext As String
Dim XLS As Variant
Dim sPath As String

sPath = "c:\baseline\"

tmp = Dir(sPath & "*.*")
Do While tmp > ""
ext = LCase(Right(tmp, 3))
Select Case ext

Case "xls"
Set XLS = New Application
Set oBook = XLS.Workbooks.Open(sPath & tmp)
For Each oSheet In oBook.Worksheets
With oSheet.PageSetup
.PrintArea = ""
.LeftFooter = "&D"
.CenterFooter = "&Z&F"
.RightFooter = "&P"
End With
Next oSheet
oBook.Save
Set oBook = Nothing
XLS.Quit
Set XLS = Nothing

Select Case WRD
Case "doc"
Set DOC = New Application
WRD.Documents.Open sPath & tmp
With Documents.PageSetup
.Print Area = ""
.LeftFooter = "&Z&F"
'WRD.ActiveDocument.Save
'RD.Quit
'Set WRD = Nothing
'Case "ppt"

' Case "???" ' visio

End Select
tmp = Dir
Loop
MsgBox "Job Complete"

End Sub

Now When compiling.. VB highlights ENd Select (4th to last line)
and says its an End Select without a Select Case...

Thanks.

You have an extra Select Case in there. It should look kind of like this:

VB Code:

Sub MacroUpdateFooter()
    
    Dim tmp As String
    Dim ext As String
    Dim XLS As Variant
    Dim sPath As String
    
    sPath = "c:\baseline\"
    
    tmp = Dir(sPath & "*.*")
    Do While tmp > ""
        ext = LCase(Right(tmp, 3))
        Select Case ext
            Case "xls"
                Set XLS = New Application
                Set oBook = XLS.Workbooks.Open(sPath & tmp)
                For Each oSheet In oBook.Worksheets
                    With oSheet.PageSetup
                        .PrintArea = ""
                        .LeftFooter = "&D"
                        .CenterFooter = "&Z&F"
                        .RightFooter = "&P"
                    End With
                Next oSheet
                oBook.Save
                Set oBook = Nothing
                XLS.Quit
                Set XLS = Nothing
            Case "doc"
                Set DOC = New Application
                WRD.Documents.Open sPath & tmp
                With Documents.PageSetup
                .Print Area = ""
                .LeftFooter = "&Z&F"
                'WRD.ActiveDocument.Save
                'RD.Quit
                'Set WRD = Nothing
            Case "ppt"
                
            Case "???" ' visio
            
        End Select
        tmp = Dir
    Loop
    MsgBox "Job Complete"
 
End Sub

BTW, please indent your code and use the VBCode tags. It's a lot easier to read that way, and in this case, would have found your problem for you.

I tried compiling without the 2nd select case... and I get the same error:
"End Select without Select Case"

There is no "End With" to match up to the "With Documents.PageSetup".

(VB gets confused in situations like this by End If/End With/End Select/...) ;)

if you indent your code as the examples it will make it much easier to find coding errors

pete

Case "doc"
Case "doc"
Set WRD = New Application
WRD.Documents.Open sPath & tmp
With Documents.PageSetup
.Print Area = ""
.LeftFooter = "&Z&F"
End With

It's giving me a runtime error 438

Object doesn't support this property or method.. and it highlights
WRD.Documents.Open sPath & tmp

Also, I am not sure whether I am supposed to
Put Set WRD = New Word. Application
Regardless it gives me a compilation error.

Thanks for your help.

This should be right:

VB Code:

Set WRD = New Word.Application

What compile error does that give? BTW, make sure you have a reference to the Word object library and have dimensioned WRD as a Word.Application. You also need to make sure that there is a "." between the path and the extension.

VB Code:

Dim WRD As Word.Application
Set WRD = New Word.Application
spath = "C:\My Documents\"
tmp = "test.doc"
WRD.Documents.Open (spath & tmp)

plus you must also set a reference to microsoft word

pete

The problem is that VB isn't recognizing the object word... It isn't specifically defined in the code... so how do i go about referencing to Microsoft Word as you say...
thanks.

If I remember correctly, you're working in Excel VBA. Go to Tools--->References, and check Microsoft Word in the list. You'll also have to do this for PowerPoint, Visio, etc.

I referenced Microsoft word and even started a new Macro with the following case for word files...
Private Sub Workbook_Open()

Dim WRD As Word.Application

Set WRD = New Word.Application
WRD.Documents.Open ("c:\Baseline\EC - JIT TRAINING - July 25 2005 - v1.0.doc")

WRD.ActiveDocument.PageSetup
With WRD.ActiveDocument.PageSetup
.LeftFooter = "&Z&F"
End With
WRD.ActiveDocument.Save
RD.Quit
Set WRD = Nothing
End Sub


And I get an invalid property use message for the ActiveDocument.PageSetup code...
So Essentiallly Excel is still having trouble opening the Word Document..
Any suggestions?

Remove the following line (as it isnt valid):

VB Code:

WRD.ActiveDocument.PageSetup

K thanks,
Is there a better way to setup footers in Word other then identifying exactly where tehy go.. perhaps something like
.footer = " " Where in the quotes i would have a string with &Z&F and etc with the necessar spaces and indentations between the components of the footer,.

I can't remember how to set the footer in Word (LeftFooter and similar do not work), but the text you need (as with doing it manually) is a tab character, eg:

VB Code:

??? = "Left" & vbTab & "Center" & vbTab & "Right"

Does anyone know how to set the footer in Word using Macros?
Thanks.

Btw, for this program to work on a whole drive i would need to implement recursion. I am sure this has been talked about before this forum.. can anyone link me there.

VB Code:

Sub foot()
 
Dim f As HeaderFooter, s As Section
For Each s In Documents(1).Sections
    For Each f In s.Footers
        f.Range = "well well it worked"
    Next f
Next s
 
End Sub

there are 3 footers in the footers collection of each section of each document, so you will have to work out which one you want, one (footers(1) or f.index = 1) is the normal footer, one the first page footer if it is different and the third is for even pages

Quote:

---

Btw, for this program to work on a whole drive i would need to implement recursion. I am sure this has been talked about before this forum.. can anyone link me there

---

have a look at this thread for code by vbasicgirl to find all files in folder and subfolder, using api call, change *.* to *.Doc or whatever and implement you code in place of List1.AddItem spath & sdir

What is the f and s in your explanations. Are those new variables.. I wasn't able to dim it.

you will have to use the full object name to dim them

maybe dim s as WRD.section, f as WRD.headerfooter

Dim footer As WRD.headerfooter ... is not a valid statement.. this has to be a variant or a string or whatever the Macros alows it to be.
Thanks.

Change WRD.?? in westconn1's example to Word.??