Formatting Excel workbook from vba in access 2003

[nyneave]

I am creating a workbook externally via vba in Access 2003. Then I use the following code to try and format it (the workbook consists of multiple worksheets which are all named at the time of creation so the worksheet names are unknown to me until it is built). The code executes, the completed msg box displays and the worksheet is where I expect to find it; but it is NOT formatted. I am not receiving an error so I don't know what I am doing wrong. Can anyone help?

Dim filePath As String

Dim xl As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

filePath = "U:\Filepath\subfolder\" TestFile.xls"

Set xl = CreateObject("Excel.Application")
Set xlBook = xl.Open(filePath)
xl.Visible = True

With xlBook
.Windows(1).Visible = True

For Each x1Sheet In xlBook.Worksheets
With x1Sheet.Range("A1:M50") --I tried both a range selection and a currentregion command
Font.Name = "Arial"
Font.Size = 10


Font.Bold = True

End With
Next x1Sheet
'are you planning to SAVE & CLOSE the workbook?

.Save
.Close
End With
'clean up
xl.Quit

Set xlBook = Nothing
Set xl = Nothing

MsgBox "Worksheets Created", vbInformation
Cancel = True
End Sub

Thank you,
Nyneave

[Rod]

There is something smugly satisfying when someone else is experiencing the development frustration that I also experienced. In the end I had to conclude that there is a difference in driving Excel from Access VBA and driving Excel directly and that certain formatting commands, that work perfectly well locally, do not work when issued from Access VBA. However having said that I never had a formatting failure when working with a range of a single sheet; all my failures occurred with multiple-sheet formatting.

Before I even try to help you with your particular requirement may I make a crucial observation. This concerns how you are opening Excel. It is dangerous to simply issue a CreateObject command since this will create another Excel application even if there is already one in existence. With two or more Excel applications running simultaneously weird and 'wonderful' things happen. You may experience errors that occur only on the first, third, fifth, ... iteration (or alternately on the second, fourth, ..). (What you describe is typical of a multi-Excel environment: it appears to work, there is no error message but nothing happens. I suspect it is working, but not in the application you expect!)

When you open Excel from the desktop, the system either opens a new workbook in the existing Excel application or creates an Excel application and then opens the workbook. At no time does the system create a second application. When you open Excel from Access VBA you have to do it in two stages: open the application if necessary; open the workbook. Furthermore Access VBA opens the application as hidden so you may not realise that there is an Excel application already running. Once you have lost reference to a hidden Excel application or have created a multi-Excel application situation, the only sure way clearing and resetting everything is to reboot!

Here is the Access VBA code that I use when opening Excel via Ofice Automation.

    On Error Resume Next
    Set mxlsApp = GetObject(, "Excel.Application")
    Select Case Err.Number
    Case 0
        On Error GoTo ThisProcedure_Error
    Case 429
        On Error GoTo ThisProcedure_Error
        Set mxlsApp = CreateObject("Excel.Application")
    Case Else
        GoTo ThisProcedure_Error
    End Select

Judging by your post you are competent with VBA so let me be brief in describing the code. If VBA finds an existing Excel application then there is no error (0). If VBA fails to find an existing Excel application, error 429 is issued and this is the situation, the only situation, when creation of an Excel application should be attempted.

Change your code to something similar. If your problems persist then get back to me, something else is going on.

[nyneave]

Rod,
I am still doing something wrong; I have updated the following to run based on the case check you had me do and I am now receivng my error message "Formatting did not work".

Dim filePath As String

Dim xl As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

filePath = "U:\Enrollment\Public\NEWBORN\" & strFileName & " " & Format(Now, "YYYY-MM-DD") & ".xls"

Set xl = GetObject(, "Excel.Application")
Select Case Err.Number
Case 0
On Error GoTo excelopenmsg_Error
Set xlBook = xl.Open(filePath)
xl.Visible = True
With xlBook
.Windows(1).Visible = True

For Each x1Sheet In xlBook.Worksheets
With x1Sheet.Range("A1:M50")
Font.Name = "Arial"
Font.Size = 10
Font.Bold = True
End With
Next x1Sheet
.Save
.Close
End With
xl.Quit

Set xlBook = Nothing
Set xl = Nothing
MsgBox "Worksheets Created", vbInformation
Cancel = True
Case Is <> 0
On Error GoTo excelopenmsg_Error
Set xl = CreateObject("Excel.Application")

Set xlBook = xl.Open(filePath)
xl.Visible = True

With xlBook
.Windows(1).Visible = True

For Each x1Sheet In xlBook.Worksheets
With x1Sheet.Range("A1:M50")
Font.Name = "Arial"
Font.Size = 10
Font.Bold = True

End With
Next x1Sheet

.Save
.Close
End With
xl.Quit

Set xlBook = Nothing
Set xl = Nothing

MsgBox "Worksheets Created", vbInformation
Cancel = True
Case Else
GoTo excelopenmsg_Error
End Select
Exit_cmdHosp_click:
Exit Sub
excelopenmsg_Error:
MsgBox "Formatting did not work", vbInformation
Cancel = True
Resume Exit_cmdHosp_click

[SteveH2508]

For Each x1Sheet In xlBook.Worksheets

Looks like a figure 1 not a letter l or is it a typo?

Have you set Option Explicit at the top of your module?

[Rod]

I'm having some difficulty in following your code at certain points, so let's deal with it component by component.

First, setting the references to the Excel objects.

    Dim filePath As String
    Dim xl As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    On Error GoTo excelopenmsg_Error
    filePath = "U:\Enrollment\Public\NEWBORN\" & strFileName & " " & Format(Now, "YYYY-MM-DD") & ".xls"
    On Error Resume Next
    Set xl = GetObject(, "Excel.Application")
    Select Case Err.Number
        Case 0
            On Error GoTo excelopenmsg_Error
        Case 429
            On Error GoTo excelopenmsg_Error
            Set xl = CreateObject("Excel.Application")
        Case Else
            GoTo excelopenmsg_Error
    End Select

Your code is missing the statements highlighted in red above.

There is another function associated with the GetObject command. If you are confident that the spreadsheet already exists then the above may be simplified.

    Dim filePath As String
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    On Error GoTo excelopenmsg_Error
    filePath = "U:\Enrollment\Public\NEWBORN\" & strFileName & " " & Format(Now, "YYYY-MM-DD") & ".xls"
    Set xlBook = GetObject(filePath)

Note that the need to specify an object reference for Excel itself is eliminated. OK, you may need it later on but it may be derived from xlBook. GetObject will open the file in the application associated with the extension, '.xls' which in most cases is Excel. (You can force the application - read up on GetObject.)

I would recommend the first method above when you are creating new spreadsheets and the second method when the spreadsheet already exists.

Let me know which way you choose and we'll take it from there.

[SteveH2508]

Another thought - have you done a debug.print of your filepath?

filePath = "U:\Enrollment\Public\NEWBORN\" & strFileName & " " & Format(Now, "YYYY-MM-DD") & ".xls"

Where is strFileName being set?

I would also be suspicious of the quotes around the YYYY-MM-DD. You are creating a string - I think you might need to double the quotes up.

[Rod]

Format(Now, "YYYY-MM-DD") works perfectly well as it is. It returns a string; no additional quotation marks are necessary.

[nyneave]

Rod,

I corrected all of the "x1" to be "xl" - must've been a typo. The file itself is built in code prior to running this "formatting code" so the filename is built there.

I had tried altering the code to replace case 429 with case <> 0 and had put the formatting within each case statement. I have now switched it back per your direction...and I am still getting my msg "Formatting did not work". I have verified that the file exists already before the code runs. Any other thoughts?

Dim filePath As String

Dim xl As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
On Error GoTo excelopenmsg_Error
filePath = "U:\Enrollment\Public\NEWBORN\" & strFileName & " " & Format(Now, "YYYY-MM-DD") & ".xls"
On Error Resume Next
Set xl = GetObject(filePath)
''(, "Excel.Application")
Select Case Err.Number
Case 0
On Error GoTo excelopenmsg_Error
Set xlBook = xl.Open(filePath)

Case 429
On Error GoTo excelopenmsg_Error
Set xl = CreateObject("Excel.Application")
Case Else
GoTo excelopenmsg_Error
End Select
Set xlBook = xl.Open(filePath)
xl.Visible = True

With xlBook
.Windows(1).Visible = True

For Each xlSheet In xlBook.Worksheets
With xlSheet.Range("A1:M50")
Font.Name = "Arial"
Font.Size = 10
Font.Bold = True

End With
Next xlSheet

.Save
.Close
End With
xl.Quit

Set xlBook = Nothing
Set xl = Nothing

MsgBox "Worksheets Created", vbInformation
Cancel = True

Exit_cmdHosp_click:
Exit Sub
excelopenmsg_Error:
MsgBox "Formatting did not work", vbInformation
Cancel = True
Resume Exit_cmdHosp_click
End Sub

[John_G]

Hi -

In this bit of code -

For Each x1Sheet In xlBook.Worksheets
With x1Sheet.Range("A1:M50") --I tried both a range selection and a currentregion command
Font.Name = "Arial"
Font.Size = 10
Font.Bold = True

You are misssing a period before each of the Font... properties, so the With is not being recognized. Try:

For Each x1Sheet In xlBook.Worksheets
With x1Sheet.Range("A1:M50") --I tried both a range selection and a currentregion command
.Font.Name = "Arial"
.Font.Size = 10
.Font.Bold = True
end with

[Rod]

There are nested With statements in the code as well as missing periods (or a With without an End With).

On Error Resume Next
    Set xl = GetObject(filePath)
    ''(, "Excel.Application")
        Select Case Err.Number
        Case 0
            On Error GoTo excelopenmsg_Error
            Set xlBook = xl.Open(filePath)
        Case 429
            On Error GoTo excelopenmsg_Error
            Set xl = CreateObject("Excel.Application")
            Set xlBook = xl.Open(filePath)
        Case Else
            GoTo excelopenmsg_Error
        End Select

The red lines above will not work; it should be

Set xl = GetObject(,"Excel.Application")

You need to duplicate the assigment of xlBook for Case = 429 as well (blue statement above) or delete the green statement and let your assignation happen later - you have another assignation following the Select statements!

With xlBook
            .Windows(1).Visible = True

Don't think there's an End With for this - but why bother with a With anyway?

After you make all the corrections the code should work, but in my experience it will be slow. How many worksheets are there? Once it's all working as is I'll give you the multisheet formatting code to see if that works.

[nyneave]

same thing...I changed the red text above because in an earlier post you told me if the spreadsheet already existed to use:

Set xl = GetObject(filePath)

The rest was the original "getobject" commented out:

''(, "Excel.Application")

I am pulling my hair out here - I even tried hard-coding the file path name in case it wasn't finding it...still no formatting happening. The formating is for about 10-15 worksheets but only 1-50 rows on each and I am just trying to make the output look presentable. I have made all changes to code per your input:

Dim filePath As String

Dim xl As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim strname As String

On Error GoTo excelopenmsg_Error
strname = "HOSPITAL_T#_FEEDBACK" & " " & Format(Now, "YYYY-MM-DD") & ".xls"
filePath = "U:\Enrollment\Public\NEWBORN\" & strname
On Error Resume Next
Set xl = GetObject(, "Excel.Application")
Select Case Err.Number
Case 0
On Error GoTo excelopenmsg_Error
Set xlBook = xl.Open(filePath)

Case 429
On Error GoTo excelopenmsg_Error
Set xl = CreateObject("Excel.Application")
Set xlBook = xl.Open(filePath)
Case Else
GoTo excelopenmsg_Error
End Select

With xlBook
.Windows(1).Visible = True

For Each xlSheet In xlBook.Worksheets
With xlSheet.Range("A1:M50")
Font.Name = "Arial"
Font.Size = 10
Font.Bold = True

End With
Next xlSheet

.Save
.Close
End With
xl.Quit

Set xlBook = Nothing
Set xl = Nothing

MsgBox "Worksheets Created", vbInformation
Cancel = True

Exit_cmdHosp_click:
Exit Sub
excelopenmsg_Error:
MsgBox "Formatting did not work", vbInformation
Cancel = True
Resume Exit_cmdHosp_click
End Sub


Thanks,
Nyneave

[Rod]

because in an earlier post you told me if the spreadsheet already existed to use:

No, I gave you two discrete solutions; you cannot select a statement from one solution and use it in the other.

I have not tested the following code but it really should be as simple as this. If you want the multisheet formatting solution then get back to me.

Private Sub cmdHosp_Click()

    Dim filePath As String
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    On Error GoTo cmdHosp_Click_Error

    filePath = "U:\Enrollment\Public\NEWBORN\" & strFileName & " " & Format(Now, "YYYY-MM-DD") & ".xls"
    
    Set xlBook = GetObject(filePath)
    For Each xlSheet In xlBook.Worksheets
        With xlSheet.Range("A1:M50")
            .Font.Name = "Arial"
            .Font.Size = 10
            .Font.Bold = True
        End With
    Next xlSheet
    xlBook.Save
    xlBook.Close
    Set xlBook = Nothing
    MsgBox "Worksheets Formatted", vbInformation

  
Exit_Procedure:
    On Error GoTo 0
    Exit Sub

cmdHosp_Click_Error:
    On Error GoTo 0
    MsgBox "Formatting did not work", vbInformation
    Err.Raise Err.Number
    Resume Exit_Procedure
    Resume

End Sub

[nyneave]

Now I am back to where I started. I put back in the simplified code (exactly as you have above) and I get the following error:

Run Time error '91' Object Variable or With Block variable not set.

The line in the code that is highlighted in debugger is:

Set xlBook = xl.Open(filePath)

[Rod]

Did you retype or copy-and-paste?

Where is strFileName assigned?

Is the file extension .xls or .xlsx?

Is Option Explicit specified?

Did you check with Debug/Compile before executing your code?

It's unlikely that a With block is causing the error and therefore the culprit is xlBook or, maybe, filePath. (I have now tested to this point in my system and all works fine.) The favourite culprit is xlBook; check for typos.

OK, copy and paste the following code to replace what you have. Use Debug/Compile to check for sytax errors, missing references, etc. Then execute the code.

Private Sub cmdHosp_Click()
    Dim filePath As String
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    On Error GoTo cmdHosp_Click_Error
    filePath = "U:\Enrollment\Public\NEWBORN\" & strFileName & " " & Format(Now, "YYYY-MM-DD") & ".xls"
    Set xlBook = GetObject(filePath)
    Set xlApp = xlBook.Application
    xlApp.Visible = True
    xlBook.Windows(1).Visible = True
    Stop  
Exit_Procedure:
    On Error GoTo 0
    Exit Sub
cmdHosp_Click_Error:
    On Error GoTo 0
    MsgBox "Formatting did not work", vbInformation
    Err.Raise Err.Number
    Resume Exit_Procedure
    Resume
End Sub

Execution will halt at the Stop statement. Your spreadsheet should, at this point, be loaded and visible.

[rpeare]

I'll just throw this out here, this is an example I did for someone else but it sounds like your format is always the same so couldn't you create a 'template' excel file then fill it in with your information and save the file as something new without having to mess with the formatting each time?

contacts_DB-Modified.zip