Formatting Excel 2007 worksheets within Acess using VBA

[commandchief]

I had the function below working in AccessXP but it no longer works in Access 2007. I get an error that says it can't create object. Any suggestions??

Function fixXLS(mySheetPath)

Set Xl = CreateObject("Excel.application")
Set Xlbook = GetObject(mySheetPath)

Xl.Visible = xlSheetHidden
Xlbook.Windows(1).Visible = True

Set Xlsheet = Xlbook.Worksheets(1)
Xlsheet.range("a1", "s600").AutoFormat
Xlsheet.range("a1", "s1").Font.Bold = True
Xlsheet.range("a2").Font.Bold = False
Xlsheet.range("a2").Font.Name = arial
Xlsheet.range("a2", "s400").EntireColumn.AutoFit
Xlbook.Save
Xlbook.Close
Xl.Quit
Set Xlbook = Nothing
Set Xlsheet = Nothing
Set Xl = Nothing

End Function

 

[SkipVought]

hi,

How about this...

    Set Xlbook = xl.Workbooks.Open(mySheetPath)

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[commandchief]

Now I get Method 'Open' of object 'Workbooks' failed

 

[SkipVought]

What is the value of mySheetPath?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[commandchief]

\\ga-13025-fs\reports\attached names.xls"

I've tried it with the new Excel format also using .xlsx extension. I have about 40 different spreadsheets in that location and my code walks through an Access table and formats each of the spreadsheets. I would hate to have to do this manually.

 

[SkipVought]

Try declaring your object variables as Excel.Application, Excel.Workbook, Excel.Worksheet in the function. Also set a reference in Tools > Reference to the Microsoft Excel Object Library.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[commandchief]

Still not working..

 

[SkipVought]

Please post the current version of your unworkable code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[commandchief]

Here it is. It's bombing on the 'GetObject(mySheetPath)

Function fixXLS(mySheetPath)

Dim xl As Excel.Application
Dim XlBooks As Excel.Workbook
Dim XlSheets As Excel.Worksheet
Set xl = CreateObject("Excel.application")
Set XlBooks = GetObject(mySheetPath)
Set XlSheets = xl.Open(mySheetPath)
xl.Visible = xlSheetHidden
' XlBook.Windows(1).Visible = True

Set XlSheet = XlBooks.Worksheets(1)
XlSheet.range("a1", "s600").AutoFormat xlRangeAutoFormatClassic1
XlSheet.range("a1", "s1").Font.Bold = True
' Xlsheet.range("a1", "s1").ColorIndex = 15
' Xlsheet.range("a1", "s1").Pattern = xlSolid
XlSheet.range("a2").Font.Bold = False
XlSheet.range("a2").Font.Name = arial
XlSheet.range("a2", "s400").EntireColumn.AutoFit
XlBook.Save
XlBook.Close
xl.Quit
Set XlBook = Nothing
Set XlSheet = Nothing
Set xl = Nothing

End Function

 

[SkipVought]

Sorry that I was not clearer in my former post...

Function fixXLS(mySheetPath)
    
    Dim xl As Excel.Application
    Dim XlBooks As Excel.Workbook
    Dim XlSheets As Excel.Worksheet
    Set xl = CreateObject("Excel.application")[s]
   Set XlBooks = GetObject(mySheetPath)[/s][b]
   Set XlBooks = xl.Open(mySheetPath)[/b]

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

What about this ?

Function fixXLS(mySheetPath)
If Dir(mySheetPath) = "" Then
  MsgBox "Can't find '" & mySheetPath & "'"
  Exit Function
End If
Dim xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set XlBook = xl.Workbooks.Open(mySheetPath)
Set XlSheet = XlBook.Worksheets(1)
XlSheet.Range("A1", "S600").AutoFormat xlRangeAutoFormatClassic1
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[commandchief]

Okay, looks like we are almost there. I can see the file opens and the formatting takes place but the file does not close so it can go to the next spreadsheet to format.

 

[PHV]

but the file does not close
???

 

[SkipVought]

Well THAT certainly does NOT make sense, as you have

    XlBook.Save
    XlBook.Close

Please post your current code, and PLEASE do not make use have to ask for that again!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[commandchief]

My bad!!! On closer review and stepping through the code, it opens the file but still hangs on the "Method 'Open' of object 'Workbooks' failed", run-time error -2147417851.

 

[SkipVought]

it opens the file but still hangs on the "Method 'Open' of object 'Workbooks' failed", run-time error -2147417851.

Now that REALLY makes not a scintilla of sense!

I already asked for what you need to supply but fail to do so, each time you post your problem!!!!

Waiting..................

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[commandchief]

Not sure what else you need from me. I guess I'll purchase a book. Just can't understand why it works under AccessXP and not 2007 unless it's something with Excel 2007.

 

[SkipVought]

YOUR CURRENT CODE!!!!!!!!!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[commandchief]

Okay, here's all the code. The Sub cmdFormatRpts_click procedure calls the fixXLS function to format the spreadsheet and walks through the records table that has the attachment names.


Option Compare Database

Private Sub cmdFormatRpts_Click()
Dim intRecordCount As Integer
Dim SQL As String
Dim rs As New ADODB.Recordset
Dim strAttach As String
Dim strTo As String
Dim strCC As String
Dim strBody As String
Dim strSubject As String
Dim mySheetPath As String

DoCmd.SetWarnings False
DoCmd.SetWarnings True
intRecordCount = DCount("*", "tblSendReports")


SQL = "Select * from tblSendReports"

rs.Open SQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

With rs
Do Until rs.EOF
mySheetPath = "\\ga-13025-fs\g1\apps\reports\" & rs!Attachment
fixXLS (mySheetPath)
Me.Repaint
rs.MoveNext

Loop

Me.cmdFormatRpts.Caption = "Completed"

rs.Close
Set rs = Nothing

End With


Function fixXLS(mySheetPath)

If Dir(mySheetPath) = "" Then
MsgBox "Can't find '" & mySheetPath & "'"
Exit Function
End If
Dim xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set XlBook = xl.Workbooks.Open(mySheetPath)
Set XlSheet = XlBook.Worksheets(1)
XlSheet.Range("A1", "S600").AutoFormat xlRangeAutoFormatClassic1

XlSheet.Range("a1", "s1").Font.Bold = True
XlSheet.Range("a1", "s1").ColorIndex = 15
XlSheet.Range("a1", "s1").Pattern = xlSolid
XlSheet.Range("a2").Font.Bold = False
XlSheet.Range("a2").Font.Name = arial
XlSheet.Range("a2", "s400").EntireColumn.AutoFit
XlBook.Save
XlBook.Close
xl.Quit
Set XlBook = Nothing
Set XlSheet = Nothing
Set xl = Nothing

End Function

 

[SkipVought]

And you are saying that the workbook does NOT open. Rather, you get an error message.

If that's the case, you may have a 2007 issue, that I cannot help you with.

On another note, however, the remainder of your code has a few problems...

    XlSheet.Range("a1", "s1")[b].Interior[/b].ColorIndex = 15
    XlSheet.Range("a1", "s1")[b].Interior[/b].Interior.Pattern = xlSolid
    XlSheet.Range("a2").Font.Bold = False
    XlSheet.Range("a2").Font.Name = [b]"arial"[/b]

The ColorIndex property, either references the Interior or Font.

Unless you have declared arial as variable or constant that contains the string value "arial", it must be enclosed in QUOTES.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}