Excel Formatting

It all worked!

Two weird things though :

1- The excel file opens, then close.
2- When I reopen it manually, it gives me a message saying that the format of the file is different than its extension.

What about this?


Edit :

For case 1, I set objXL.Visible = False instead and it works without opening the file.
For case 2, still having the same message.
I'm adding case 3 : It adds a backup of the export excel file for some reason. Edit : I see that the backup file is the file before the column names are corrected and it has .xlk extension.
 
Last edited:
It all worked!

Two weird things though :

1- The excel file opens, then close.
Yes, because we close it with xlWB.Close and the True after that says to save it. If you want it to remain open just get rid of that line and then put in
objXL.UserControl = True

instead.
2- When I reopen it manually, it gives me a message saying that the format of the file is different than its extension.
What version of Office do you have? What is the value of outputFileName?

What about this?


Edit :

For case 1, I set objXL.Visible = False instead and it works without opening the file.
It still opens the file. It just isn't visible.
For case 2, still having the same message.
Again what is the value of outputFileName?
I'm adding case 3 : It adds a backup of the export excel file for some reason.
Probably due to the extension issue.
 
What version of Office do you have? What is the value of outputFileName?

Office 2007
outputFileName = "FileName.xls"
 
Change to

outputFileName = "FileName.xlsx"
 
That does the trick *Thumbs up*

Now there's the backup file left...
 
I can't seem to call the function.

Code:
Call ExportFunction.ExcelExportFunction

Edit : I'm not sure I have the DAO reference. How is it called exactly?

Edit : I found it : "Microsoft DAO 3.6 Object Library", but it gives me this error when I add it : "Module name, project or library already in use"

What must I do? :(
 
Last edited:
I can't seem to call the function.

Code:
Call ExportFunction.ExcelExportFunction

Edit : I'm not sure I have the DAO reference. How is it called exactly?

Edit : I found it : "Microsoft DAO 3.6 Object Library", but it gives me this error when I add it : "Module name, project or library already in use"

What must I do? :(

The function is called by using

SendTQ2Excel "TableOrQueryNameHere"

You don't need to set the library because it is already there (it is the Access Database Engine - or ACE as it is known, which is the Access team's version of DAO).
 
It can't seem to find my table =/
It's existing and well spelled, though it can't find it.
 
Post the code again so we can take a look.
 
Code:
If MsgBox("Any Excel file with the same name will be overwritten." & vbNewLine & vbNewLine & _
          "Do you want to continue Exportation?", vbYesNo + vbExclamation, "Warning !") = vbYes Then
     
    'DoCmd.RunSQL ("DROP TABLE TempExportTab")
     
    Dim sSQL As String
    sSQL = "SELECT * INTO TempExportTab FROM SelectAllFieldsReq;"
    CurrentDb.Execute sSQL, dbFailOnError
    
    Me.Refresh
    
    Call ExportMyTable
    
    DoCmd.RunSQL ("DROP TABLE TempExportTab")
 
    ........
 
End If
 
Function ExportMyTable()
    Dim objXL As Object
    Dim xlWB As Object
    Dim rst As DAO.Recordset
    Dim i As Integer
 
    ExcelExportFunction "TempExportTab"
    Set objXL = CreateObject("Excel.Application")
    objXL.Visible = False
    
    Set xlWB = objXL.Workbooks.Open(CurrentProject.Path & "\" & outputFileName)
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM ExportColumnNamesTab ORDER BY [TableTruncatedNames];")
 
    For i = 1 To xlWB.ActiveSheet.UsedRange.Columns.Count
        Do Until rst.EOF
            If xlWB.ActiveSheet.Cells(1, i) = rst!TableTruncatedNames Then
                xlWB.ActiveSheet.Cells(1, i).Value = rst!FullNames
                Exit Do
            End If
            rst.MoveNext
        Loop
        rst.MoveFirst
    Next
 
xlWB.Close True
objXL.Quit
Set objXL = Nothing
End Function
 
I found out that the outputFileName wasn't reaching the ExportFunction. I fixed that.

Now it can't open the exported file. Stops here :

Code:
Function ExportMyTable()
    Dim objXL As Object
    Dim xlWB As Object
    Dim rst As DAO.Recordset
    Dim i As Integer
 
    ExcelExportFunction "TempExportTab"
 
    Set objXL = CreateObject("Excel.Application")
    objXL.Visible = False
 
    [COLOR=red]Set xlWB = objXL.Workbooks.Open(CurrentProject.Path & "\" & outputFileName)[/COLOR]
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM ExportColumnNamesTab ORDER BY [TableTruncatedNames];")
 
    For i = 1 To xlWB.ActiveSheet.UsedRange.Columns.Count
        Do Until rst.EOF
            If xlWB.ActiveSheet.Cells(1, i) = rst!TableTruncatedNames Then
                xlWB.ActiveSheet.Cells(1, i).Value = rst!FullNames
                Exit Do
            End If
            rst.MoveNext
        Loop
        rst.MoveFirst
    Next
 
xlWB.Close True
objXL.Quit
Set objXL = Nothing
End Function

Edit : I think it's not being created from the ExcelExportFunction "TempExportTab" part

Edit : I went in debug mode and I placed a stop in the function and yet I got the error at the line after the call of the function without even stopping at the point in the function. Just like it skipped it.
 
Last edited:
There's an error in the function, so it skips the exporting part.

Code:
Option Compare Database
Public Function ExcelExportFunction(strTQName As String, Optional strSheetName As String)
' strTQName  is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to name it to
    
    strTQName = outputFileName
    strSheetName = "Export"
    
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
 
    [COLOR=red]On Error GoTo err_handler[/COLOR]
 
    Set rst = CurrentDb.OpenRecordset(strTQName)
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
        
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    If Len(strSheetName) > 0 Then
        xlWSh.Name = Left(strSheetName, 34)
    End If
    xlWSh.Activate
    xlWSh.Range("A1").Select

    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own strSheetName .
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
    rst.Close
    Set rst = Nothing
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function
 
Go to the VBA Window and to DEBUG > PROJECT and see what happens. Does it say there's a compile error and then go to it?

Do you maybe have an Excel Reference set? If so, then remove the two constants (xlCenter and xlBottom) as that could be conflicting. The constants would be there in case there was no reference set and late binding used.
 
I got it to work.

It's exporting correctly, or so. This formatting is insane. The main prolem is that the workbook doesn't have a name and it's saved, so I can't hook the part we made earlier to fix the header. I would also like the file to be created without opening and be closed silently after.

How can I fix that?
 
Last edited:
This formatting is insane.
Not sure that is a positive or negative statement but if it is negative, just remove all of the formatting code in that function. I don't use it myself but Bob Larson, who posted that on his site, included it (apparently so someone would have a sample of how they could do it).

The main prolem is that the workbook doesn't have a name.
Do you mean workSHEET? Because the workbook has a name, it is the file name. That is the workbook. If you want to name the worksheet, he has other code on that same site to do that as well.

I would also like the file to be created without opening and be closed silently after.
And now we're back again to where the xlWB.Close True code was. So get rid of the objXL.UserControl = True code and put the xlWB.Close True code back in.
 
I added

Code:
xlWBk.Close True
ApXL.Quit

to the function and it did the trick for the silent work. But now it just pops a window to save the file. I would need to save it with the right name in the right folder in order to hook the rest of the code to it.
 
Do you mean workSHEET? Because the workbook has a name, it is the file name. That is the workbook. If you want to name the worksheet, he has other code on that same site to do that as well.

When the Excel file opens, its name is "Workbook1".
 
When the Excel file opens, its name is "Workbook1".
Are you using an Excel Template file?

Because your code here:
Code:
    Set objXL = CreateObject("Excel.Application")
    objXL.Visible = False
 
[COLOR=black]    Set xlWB = objXL.Workbooks.Open(CurrentProject.Path & "\" & outputFileName)[/COLOR]
[COLOR=black]
[/COLOR]

is opening the outputFileName, so whatever outputFileName is that is the workbook name. If it is a template then you will need to do a SAVE AS instead of a save. So

xlWB.SaveAs CurrentProjectPath & "\A New NameHere.xlsx"

or using a variable.
 
This part of the code is not linked to the Bob Larson's function. I need to change a couple of things in his function so that it creates the workbook and save it instead of just opening it and have the user save it manually.
 

Users who are viewing this thread

Back
Top Bottom