1

Here I have some VBA code that outputs a ton of files into Excel files. My question is, from this, is there anyway for it to Format the excel file a bit? What I would like to do is make the Columns bold and make the columns fit the size of the header as well.

Sub OutPutXL()


Dim qdf As QueryDef
Dim rs As DAO.Recordset

Set qdf = CurrentDb.QueryDefs("OutputStudents")
Set rs = CurrentDb.OpenRecordset("Teachers")

Do While Not rs.EOF
qdf.SQL = "SELECT * FROM Students WHERE contact='" & rs!contact & "'"

''Output to Excel
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
qdf.Name, "C:\Users\chrisjones\Documents\ProjectionsFY14\Teachers\" _
& rs!contact & ".xls", True
rs.MoveNext
Loop

End Sub
Chris Jones
  • 662
  • 2
  • 10
  • 23

4 Answers4

2

this is a quick and dirty combination of Phil.Wheeler's Code and my previous input, for me this is working. Don't forget to add Excel's Object Library in your Access-Macro.

Sub doWhatIWantTheDirtyWay()

pathToFolder = "C:\Users\Dirk\Desktop\myOutputFolder\"
scaleFactor = 0.9

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts = False

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(pathToFolder)

For Each objFile In objFolder.Files
    If objFso.GetExtensionName(objFile.path) = "xls" Then
         Set objWorkbook = objExcel.Workbooks.Open(objFile.path)
         For Each sh In objWorkbook.Worksheets

            If sh.UsedRange.Address <> "$A$1" Or sh.Range("A1") <> "" Then
                With sh
                    columncount = .Cells(1, 256).End(xlToLeft).Column
                    For j = 1 To columncount

                        With .Cells(1, j)
                            i = Len(.Value)
                            .ColumnWidth = i * scaleFactor
                            .Font.Bold = True
                        End With
                    Next
                End With
            End If
         Next
         objWorkbook.Close True
    End If
Next

objExcel.Quit



End Sub
Community
  • 1
  • 1
peter
  • 2,103
  • 7
  • 25
  • 51
  • Your answer is correct as far as it goes, but doesn't address the important aspect of how to do this from Access for the specified, and closed, workbooks. – Doug Glancy Jan 18 '13 at 14:47
  • You're right, of course. I'd suggest creating an excel-macro that loops through all files in your output-folder and then does as written above. If you put that macro in the Workbook_Open() event, you should be able to do what you want from access by opening just this one workbook. – peter Jan 18 '13 at 14:50
  • Hm.. on the other hand you could probably do withouth this super cool excelfile and do it all from access :o) but I think Remou is write, you'll have to open the files for that. – peter Jan 18 '13 at 14:56
1

I have come across this problem a couple of times as well. As @Remou said, you will need to open excel to format xls files, this modification of your code silently opens Excel and that should get you in the right direction. Remember to add a reference to the Microsoft Excel Object Library in your VBA project.

Sub OutPutXL()
Dim qdf As QueryDef
Dim rs As DAO.Recordset
Dim xl as Excel.Application
Dim wb as Object
Dim strFile as string

Set qdf = CurrentDb.QueryDefs("OutputStudents")
Set rs = CurrentDb.OpenRecordset("Teachers")
Set xl = New Excel.Application
xl.DisplayAlerts = False

Do While Not rs.EOF
    qdf.SQL = "SELECT * FROM Students WHERE contact='" & rs!contact & "'"

    'Output to Excel
    strFile = "C:\Users\chrisjones\Documents\ProjectionsFY14\Teachers\" & rs!contact & ".xls"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, qdf.Name, strFile, True

    'Start formatting'
    Set wb = xl.Workbooks.Open(strFile)
    With wb.Sheets(qdf.name)
        'Starting with a blank excel file, turn on the record macro function'
        'Format away to hearts delight and save macro'
        'Past code here and resolve references'
    End With
    wb.save
    wb.close
    set wb = Nothing
    rs.MoveNext
Loop
xl.quit
set xl = Nothing
End Sub
MMerry
  • 334
  • 2
  • 11
1

Yes it is possible! This is hacked together from one of my codes, might need a bit of editing before it works...

'This deals with Excel already being open or not
On Error Resume Next
Set xl = GetObject(, "Excel.Application")
On Error GoTo 0
If xl Is Nothing Then
  Set xl = CreateObject("Excel.Application")
End If

Set XlBook = GetObject(filename)
'filename is the string with the link to the file ("C:/....blahblah.xls")

'Make sure excel is visible on the screen
xl.Visible = True
XlBook.Windows(1).Visible = True
'xl.ActiveWindow.Zoom = 75

'Define the sheet in the Workbook as XlSheet
Set xlsheet1 = XlBook.Worksheets(1)

'Then have some fun!
with xlsheet1
    .range("A1") = "some data here"
    .columns("A:A").HorizontalAlignment = xlRight
    .rows("1:1").font.bold = True
end with

'And so on...
0

You could (depending on the number of files) make a template for each file you are outputting. In the long run if someone needs to change the formatting they can change the template which is going to be easier on you now that you don't have to sift through a bunch of excel formatting garbage. You could even let a qualified end user do it.

It's one of the biggest problems I have with excel sheets if I wrote the VBA I am responsible until I die for it. This way (in theory) they should be able to change a column, without changing how the data is outputted, just presented without you.

+1 To open the excel file itself and format it using that automation though.

Bmo
  • 1,212
  • 11
  • 34