Access VBA -- Export into Excel -- Keep Certain Format Elements

[skydivetom]

Hello:



See below VBA routine which allows to export multiple Access tables into a single Excel file... it works without any issues, but I'd like to slightly modify it IOT keep/set various Excel formatting requirements (e.g., column width).

Allow me to recap what the current routine accomplishes:
- Exports any Access tables where table name starts with "T1"
- For any table starting with T1, a worksheet is created where worksheet's name = table name (tdfName)
- Excel loses all formatting given the XLSX is overwritten/recreated each time
- Date is appended to Excel filename... if multiple exports on the same day, XLSX will be overwritten

What I'd like to accomplish:
- At a minimum, I'd like to specify the Excel's column width for n columns
- Given I less than 10 fields (columns) that will be created on each sheet, I'm ok with either using "Autofit" for column A:J or specifying each width for columns A:J

Current Issue:
- As mentioned, for each table (tdfName), Excel creates a worksheet.
- As of right now, the line "ExcelWkb.Worksheets("Sheet1").Columns("A:J").Colu mnWidth = 25" references "Sheet1".
- I've tried replacing "Sheet1" with tdfName, but apparently that does not work.

My questions:
- How should VBA line "ExcelWkb.Worksheets("Sheet1").Columns("A:J").Colu mnWidth = 25" be modified so that columns A:J on all exported tdf (worksheets) will be set to width = 25?
- If other code is needed, what additional lines of VBA code are needed to accomplish this task?

Option Compare Database
Option Explicit


Public Sub ExcelExport()


    'Declare variables
    Dim db As Database
    Dim xlsFileLoc As String
    Dim xlsName As String
    Dim xlsPath As String
    Dim tdf As TableDef
    Dim tdfName As String
    Dim FileExtension As String
    Dim j As Integer
    
    Dim ExcelWkb As Workbook
    
    
    On Error GoTo Export2Excel_Err
    
    'Capture date time stamp as file extension
    FileExtension = Format(Date, "yyyy-mm-dd")
    
    'Place XLSX into subfolder 'Exports'
    xlsFileLoc = CurrentProject.Path & "\Exports\"
    xlsName = "Export -- " & FileExtension & ".xlsx"
    xlsPath = xlsFileLoc & xlsName
        
    If Len(Dir(xlsPath)) > 0 Then
        Kill xlsPath
    End If
    
    Set db = CurrentDb
    
    j = 0
    


    For Each tdf In db.TableDefs
        tdfName = tdf.Name
        If Left(tdf.Name, 3) = "T1_" Then


            'Increase counter
            j = j + 1
            
            On Error Resume Next
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, tdfName, xlsPath, True
                                    




'******** I need some help w/ next line '********
            ExcelWkb.Worksheets("Sheet1").Columns("A:J").ColumnWidth = 25
            
            
            
            
            If Err > 0 Then
                Err.Clear
                Debug.Print tdfName
                j = j - 1
                Resume nextstep
            End If


        End If


nextstep:
    Next
    
    On Error GoTo Export2Excel_Err
    
        'Throw message box
        MsgBox j & " Table(s) Exported to File:" & vbCr & xlsPath, vbInformation, "Export Status"
           
Export2Excel_Exit:
    Exit Sub
    
Export2Excel_Err:
    MsgBox Err & " : " & Err.Description, , "Export2Excel()"
    Resume Export2Excel_Exit
    
End Sub

[Welshgasman]

If you are going to try and use Excel commands, you need to have an Excel object. :-)

[skydivetom]

Would you be willing to elaborate (e.g., provide a specific example) on your recommendation, pls?

[Micron]

it means reference the Excel library and use Excel vba from within Access.
All you'd ever want to know about Automation

http://www.accessmvp.com/KDSnell/EXCEL_MainPage.htm

[skydivetom]

Micron -- as part of the Export routine, the Excel 16.0 Object library is already included in the ACCDB file.

Thanks for providing the link... I'll review and determine whether or not it includes anything in support of setting the column width for the XLSX file to be created/exported.

[Welshgasman]

It might well be along with many other references, however you are not using it.

[Micron]

The only issue I see at the moment is that you declare the wb variable but you don't set it before you use it. Not sure how you get away with that.
What you have should work - similar does in Excel immediate window so syntax looks good. However I have no idea what the effect of doing that for an export is; the layout might be governed by default. You may have to use a template file, or at least save the changes in the wb you're creating in code.
"doesn't work" doesn't tell us much really.

[Welshgasman]

AFAIK you cannot use Excel objects, declared as Excel objects unless an Excel object is used?
Same goes with their ENums?. If you declare Excel as a simple object, then you have to use the equivalent numeric values, not the actual ENums.

So, research setting a Excel object from within Access.

[skydivetom]

Micron/Welshgasman -- thank you for the additional feedback/info. I'll continue the research and provide any relevant findings at the soonest.

[madpiet]

If you want standard formatting, you could set up a template to send the data to. Or you could do it all in VBA (since Excel can record Macros)...

[Minty]

I have a standard module I can send any query to that create and formats the output as a excel table.
The bit that does the formatting simply takes the file name and does everything for you.

It does rely on the export data being on sheet 1, I have another version that specifies a sheet name.
This also has a max width setting - I'm sure you can work out the nuances bases on the commented out bits.

Public Sub XLFormatTable(sFile As String,  Optional bOpen As Boolean = True)

    On Error GoTo XLFormatTable_Error
    ' Late binding to avoid reference:
    Dim xlApp            As Object        'Excel.Application
    Dim xlWB             As Object        'Workbook
    Dim xlWS             As Object        'Worksheet
    Dim tbl              As Object
    Dim rng              As Object
    Dim iSheet           As Integer
    Dim iLastCol         As Long
    Dim i                As Long
    Dim iMaxWidth        As Single
    Dim iPointsWidth     As Single
    
    iSheet = 1
    iMaxWidth = 35
    iPointsWidth = 200
    ' Create the instance of Excel that we will use to open the temp book
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = bOpen
    Set xlWB = xlApp.Workbooks.Open(sFile)
    'Debug.Print xlWB.Name
    Set xlWS = xlWB.worksheets(iSheet)

    ' Format our temp sheet
    ' ************************************************** *************************
    xlApp.Range("A1").Select

    With xlWS
        '        With .UsedRange
        '            .borders.LineStyle = xlContinuous
        '            .borders.ColorIndex = 0
        '            .borders.TintAndShade = 0
        '            .borders.Weight = xlThin
        '        End With
        '
        '        'format header 90 degree
        '        With .Range("i1:y1")
        '            .HorizontalAlignment = xlCenter
        '            .VerticalAlignment = xlBottom
        '            .WrapText = False
        '            .Orientation = 90
        '            .AddIndent = False
        '            .IndentLevel = 0
        '            .ShrinkToFit = False
        '            .ReadingOrder = xlContext
        '            .MergeCells = False
        '        End With
        '        .UsedRange.Rows.RowHeight = 15
        '        .UsedRange.Columns.AutoFit


        With xlWB.Sheets(iSheet)
            Set rng = .cells(1, 1).CurrentRegion
        End With

        Set tbl = xlWS.ListObjects.Add(xlSrcRange, rng, , xlYes)
        tbl.TableStyle = "TableStyleMedium9"
        tbl.ShowTotals = False
        
        xlWS.cells.EntireColumn.AutoFit
        xlWS.UsedRange
        iLastCol = xlWS.UsedRange.Columns(xlWS.UsedRange.Columns.Count).Column
        ' width 42
        For i = 1 To iLastCol
            If xlWS.Columns(i).Width > iPointsWidth Then
           ' Debug.Print xlWS.Columns(I).Width
                With xlWS.Columns(i)
                .ColumnWidth = iMaxWidth
                
                End With
            End If
        Next i
        xlWS.Rows.EntireRow.AutoFit
        xlWS.Rows.VerticalAlignment = xlVAlignTop
        
    End With
        
    xlWB.Save
    
    If Not bOpen Then
        xlApp.Workbooks.Close
        Set xlApp = Nothing
    Else
        xlApp.ActiveWindow.WindowState = xlMaximized
    End If
    
    On Error GoTo 0
    Exit Sub


XLFormatTable_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure XLFormatTable, line " & Erl & "."

End Sub

[skydivetom]

Minty:

Thank you for providing the sample code. You indicated the following... "I have another version that specifies a sheet name."

In my posted VBA, I'm extracting all tables that start with, e.g., "T1"... any tables that meet the prefix criteria are then exported and the worksheet names = Access' table name.

If the other version (i.e., sheet name <> "Sheet1") differs significantly in VBA code, would you be willing to also post it here? Thank you.

[señor_sriracha]

worksheet names = Access' table name. If the other version (i.e., sheet name <> "Sheet1") differs significantly in VBA code

You could get the sheet using the ordinal position rather than the name.

e.g.
.worksheets(1)

[Micron]

You could get the sheet using the ordinal position rather than the name.

If anyone moves a sheet, that could fail. Referring to the project sheet name might be better than the ordinal position since it would not be affected by position or changing the caption on the sheet tab.

[Gicu]

Here is an old procedure I used many years ago to export a query to Excel and apply various formatting to the sheet:

Private Sub cmdExcelExport_Click()
Dim oApp As Excel.Application
Dim oWT As Excel.Workbook
Dim oWS As Excel.Worksheet


Dim lastRow As Long
Dim lStartOfDataList As Long
Dim lEndOfDatList As Long
DoCmd.RunCommand acCmdSaveRecord


On Error Resume Next
Application.Echo False
Set oApp = GetObject("Excel.Application")
          If Err.Number <> 0 Then Set oApp = CreateObject("Excel.Application")
    With oApp
        .Visible = False
        .Workbooks.Close
        On Error GoTo 0
        .Workbooks.Add
        .Workbooks(1).Activate


        Set oWT = .ActiveWorkbook
        Set oWS = oWT.ActiveSheet


        .ScreenUpdating = False
        .DisplayAlerts = False
        'set orientation to landscape
        oWS.PageSetup.Orientation = xlLandscape
        'lets do the header
        oWS.PageSetup.CenterHeader = "&""Arial,Bold""&10" & "Audit Trail Report"
        'now the footer
        oWS.PageSetup.CenterFooter = "Page &P of &N"
        oWS.PageSetup.RightFooter = "Printed &D &T"
        oWS.PageSetup.LeftFooter = "Victoria International High School Programs"
                
        oWS.PageSetup.LeftMargin = oApp.InchesToPoints(0.5)
        oWS.PageSetup.RightMargin = oApp.InchesToPoints(0.5)
        oWS.PageSetup.TopMargin = oApp.InchesToPoints(1)
        oWS.PageSetup.BottomMargin = oApp.InchesToPoints(1)
        oWS.PageSetup.PaperSize = xlPaperLegal
        'force one fit one page wide
        oWS.PageSetup.Zoom = False
        oWS.PageSetup.FitToPagesWide = 1
        oWS.PageSetup.FitToPagesTall = False
        
        oWS.PageSetup.PrintTitleRows = oWS.Range("A1", oWS.Range("A1").End(xlUp)).EntireRow.Address
        'now lets paste the exception list
        DoCmd.OpenQuery "AuditTrailDateRange"
        DoCmd.RunCommand acCmdSelectAllRecords
        DoCmd.RunCommand acCmdCopy
        Set oWS = oWT.ActiveSheet
        oWS.Range("A1").Activate
        oWS.Paste
        DoCmd.OpenQuery "AuditTrailDateRange"
        DoCmd.RunCommand acCmdSelectRecord          'Minimize the risk of message: "You have copied a large amount of data..."
        DoCmd.RunCommand acCmdCopy
        DoCmd.Close acQuery, "AuditTrailDateRange", acSaveNo
                     
         'now to fit columns
        lastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
        lEndOfDatList = lastRow
        oWS.Range("A1:J" & lastRow).Select
        .Selection.Font.Size = 10
        .Selection.WrapText = True
        'oWS.Range("A1:J" & lastRow).Columns.AutoFit
        oWS.Columns(1).ColumnWidth = 22
        oWS.Columns(2).ColumnWidth = 40
        oWS.Columns(3).ColumnWidth = 30
        oWS.Columns(4).ColumnWidth = 12
        oWS.Columns(5).ColumnWidth = 25
        oWS.Columns(6).ColumnWidth = 30
        oWS.Columns(7).ColumnWidth = 30
        oWS.Columns(8).ColumnWidth = 40
        oWS.Columns(9).ColumnWidth = 50
        oWS.Columns(1).ColumnWidth = 12
        
        
        
        'lets autofit the rows
        oWS.Range("A1:J" & lastRow).Rows.AutoFit
        oWS.Range("A1").Select
        
     
        oWT.Worksheets("Sheet1").Name = "Audit Trail Reporting"
           
        
        .ScreenUpdating = True
        .DisplayAlerts = True
     End With




Application.Echo True


oApp.Visible = True
AppActivate "Microsoft Excel"
Set oApp = Nothing
End Sub

Cheers,