Restricted Chars in Field names

[VegaLA]

Good day all.

Its been a while and what I thought would be a straight forwards fix turns out to more complicated then it should be. I dare say there is an easy fix I've overlooked but having spent yesterday following various leads courtesy of Google I am still stuck on square one!

I have a query that pulls and export the data I want to Excel using the transferspreadsheet fucntion (DoCmd.TransferSpreadsheet acExport, , "QryExport", "C:\MyPath\test1.xlsx") and the data itself is fine. Its the headers that are causing issues. The field names have # in them which means I have to manually open the file and correct the headers, ideally I would like to avoid this. I created a table and had the headers as the data thinking I could create a Union query to have the Headers/field names as the first row from the table then union the query with the data but they are of different Datatypes of course so that messed that idea up.

Does anyone know of a straight forwards idea of exporting the table to the first row of an excel sheet, then exporting the results of the query from Row 2 onwards so I can avoid manipulating the export excel sheets headers?


Many thanks in advance.

Mitch.

 

[pbaldy]

Can you change them in the query? In design view:

GoodName: [BadName#]

GoodName should be exported to the spreadsheet.

 

[VegaLA]

Thanks for the reply PB.

Yes, I could change the field names in the query but then I'd be forced to change them back in the exported Excel file which is ideally what I would like to avoid doing.

I am using Access 2013 so thought this issue may have had a workaround by now?

 

[MarkK]

Doesn't TransferSpreadsheet have a parameter called 'HasFieldNames?'
From the object browser...

Sub TransferSpreadsheet([TransferType As AcDataTransferType = acImport], [SpreadsheetType As AcSpreadSheetType = acSpreadsheetTypeExcel12Xml], [TableName], [FileName], [HasFieldNames], [Range], [UseOA])

 

[VegaLA]

Hi Mark.

Yes, TransferSpreadsheet function does allow you to export the Field names with the Data. Problem I have is that the field names contain restricted Chars, in this case #. When it exports it changes ay...the field from Account# to Account. No big deal but it means I have to manually correct it in the exported file. Since I want to completely automate this export process its a bit of a bugbear for me.

My workaround would be to export a Table that has the correct fieldnames with the restricted chars as data itself into the first row of the resulting spreadsheet, and it does indeed work, however, I would then like the Data that's in the query to export to the same excel sheet but in row 2, under the forced field names exported from the table, I am just not sure how to go about this.

Thanks,
Vega.

 

[pbaldy]

Try a UNION query:

SELECT Field1, Field2, 0 As SortOrder
FROM TableWithFieldNames
UNION ALL
SELECT Field1, Field2, 1 As SortOrder
FROM Whatever
ORDER BY SortOrder

 

[VegaLA]

Thanks PB.

Yes, I did try that before but because they are different Datatypes, the forced Headers as Data from the Table being text and the real Data from the query containing numerical, Decimals and whatnot it would not work.

Thanks,
Vega.

 

[sxschech]

If you don't mind vba you could use copyfromrecordset. Couple of approaches:

1. you could create a "template file" with excel that is formatted the way you want it, that is to say you have the header row already in the first row and colors,bold, etc already laid out. Then use vba to copy that template file to a new file and paste the data into the second row. This method preserves any customization made to the excel formats.
2. Use vba to create a new excel file, use copyfromrecordset the data for the header row, then a second copyfromrecordset to paste in the data below the header row.
3. Use vba to create a new excel file, use code to paste in the values of the header row, use copyfromrecordset to paste the data below the header row. However, since you mentioned you already have a table with the data you want to be the header, then you may not need to use option 3.

If any of these might work for you, let me know which one and I'll make some sample code for you to try.

 

[pbaldy]

Thanks PB.

Yes, I did try that before but because they are different Datatypes, the forced Headers as Data from the Table being text and the real Data from the query containing numerical, Decimals and whatnot it would not work.

That was a brain cramp on my part. :banghead:

I would do something along the lines of what sxschech recommended, using Excel automation.

 

[static]

DoCmd.OutputTo acOutputQuery, "QryExport", acFormatXLSX, "C:\MyPath\test1.xlsx"

 

[VegaLA]

Thanks again guys for your advice!

sxschech, your Second option seems like the best direction for me. I don't particularly want to touch the Excel file so that option looks like the best fit for me. I tried to code this myself but it placed the second export to another Tab in the same sheet. If you know the syntax to start the second export to the second row that would be great!

Thank you.

 

[pbaldy]

sxschech appears to be offline. I declare and set a Sheet variable, then do your copying with that:

xlSheet.range("A2").copyfromrecordset rs

 

[sxschech]

Here is some sample code I modified from an existing procedure. As not sure how you are getting the file name, etc. I made some changes that may or may not apply to your situation. Since the original code relied on an existing file, I added an option for a new file, but without additional coding, it is a bit inconsistent. As is if you provide a new file, use only the file name no path or extension, this will be prompted for after the data has been pasted into excel. For an existing file (this will be copied to the name you provide, in that case you need to give the full path and file name of the existing file, you will still need to provide a new name for the file after data has been pasted.)

I also left in some of the excel calculations, color changes in case you were interested in formatting excel via access. You will need to uncomment to use it and would need to be modified for your situation as it is based on tab names, otherwise you can delete that section.

Sub FormatExcel_Recordset(Filename As String, NewFile As Boolean, Optional Customize As String)
'For a new file, filename is the name of the file without path or extension
'NewFile is True/False.  If New File set to True, If an existing file, set to false

'''''''''''''''''''''''''''''''''''''''''''
'Test changes to using qdf to assign date where clause
'''''''''''''''''''''''''''''''''''''''''''
    Dim rs As DAO.Recordset
    Dim rs1 As DAO.Recordset
    Dim stCustomize As String
    Dim FName As Variant
    Dim FNameExists As Boolean
    Dim yesno
    
    Set objapp = CreateObject("Excel.Application")
    objapp.Visible = True
    If NewFile Then
        Set wb = objapp.workbooks.Add
    Else
        Set wb = objapp.workbooks.Open(Filename, True, False)
    End If
    
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblHeader")
    Set rs1 = CurrentDb.OpenRecordset("SELECT * FROM tblDetail")
    
    
    
    For Each ws In wb.Worksheets
        'Debug.Print ws.Name
        With ws
            .Activate
            
            rs1.MoveLast
            rs1.MoveFirst

            
            'Paste Header row
            .Cells(1, 1).CopyFromRecordset rs
            
            'Paste Detail
            .Cells(3, 1).CopyFromRecordset rs1
            
'            lastrow = rs1.RecordCount + 1
'            lastCol = .Range("A1").CurrentRegion.Columns.Count
'
'            Select Case stCustomize
'                Case "EvalCourse"
'                    .Range("A2:AD2").Copy
'                    .Range("A2:AD" & lastrow + 1).PasteSpecial xlPasteFormats
'                    .Range("AH2:AS2").Copy
'                    .Range("AH2:AS" & lastrow + 1).PasteSpecial xlPasteAll
'                    .Application.CutCopyMode = False
'                    .Range("AH" & lastrow + 1).Formula = "=SUM(AH2:AH" & lastrow & ")"
'                    .Range("AI" & lastrow + 1).Formula = "=SUM(AI2:AI" & lastrow & ")/$AH" & lastrow + 1
'                    .Range("AI" & lastrow + 1 & ":AR" & lastrow + 1).FillRight
'                    .Range("AE2:AF" & lastrow).Clear
'                    '*****************
'                    'Add Total Row with avgs
'                    .Cells(lastrow + 1, 1) = "TOTALS"
'                    .Range("A" & lastrow + 1 & ":AS" & lastrow + 1).Font.Bold = True
'                    .Range("K" & lastrow + 1).Formula = "=AVERAGE(K2:K" & lastrow & ")"
'                    .Range("K" & lastrow + 1 & ":AD" & lastrow + 1).FillRight
'                    .Cells(lastrow + 1, 1).Interior.Color = RGB(255, 255, 0)                           'Yellow
'                    .Range("B" & lastrow + 1 & ":P" & lastrow + 1).Interior.Color = RGB(73, 69, 41)    'Brown
'                    .Range("K" & lastrow + 1 & ":M" & lastrow + 1).Interior.Color = RGB(51, 153, 102)  'Green
'                    .Range("N2").Formula = "=AVERAGE(K2+L2+M2)/3"
'                    .Range("N2:N" & lastrow).FillDown                                                  'Except Total Row
'                    .Range("N" & lastrow + 1).Interior.Color = RGB(255, 255, 0)                        'Yellow
'                    .Range("Q" & lastrow + 1 & ":AC" & lastrow + 1).Interior.Color = RGB(51, 153, 102) 'Green
'                    .Range("S2").Formula = "=AVERAGE(Q2+R2)/2"
'                    .Range("S2:S" & lastrow).FillDown                                                  'Except Total Row
'                    .Range("S" & lastrow + 1).Interior.Color = RGB(255, 255, 0)                        'Yellow
'                    .Range("W2").Formula = "=AVERAGE(T2+U2+V2)/3"
'                    .Range("W2:W" & lastrow).FillDown                                                  'Except Total Row
'                    .Range("W" & lastrow + 1).Interior.Color = RGB(255, 255, 0)                        'Yellow
'                    .Range("AD2").Formula = "=AVERAGE(X2+Y2+Z2+AA2+AB2+AC2)/6"
'                    .Range("W2:W" & lastrow).FillDown                                                  'Except Total Row
'                    .Range("AD" & lastrow + 1).Interior.Color = RGB(255, 255, 0)                       'Yellow
'                    .Range("AL" & lastrow + 1).Interior.Color = RGB(242, 220, 219)                     'Light Pink
'
'                    '*****************
'                Case "InstMatAvg"
'                    .Range("A2:F2").Copy
'                    .Range("A2:F" & lastrow).PasteSpecial xlPasteFormats
'                    .Application.CutCopyMode = False
'                    .AutoFilterMode = False
'                    .Range("A1:H" & lastrow).AutoFilter Field:=8, Criteria1:="1"
'                    .Range("E2:F" & lastrow).Interior.Color = RGB(218, 150, 148)
'                    .Range("A1:H" & lastrow).AutoFilter Field:=8, Criteria1:=">1"                      'More than one instructor
'                    .Range("E2:F" & lastrow).Interior.Color = RGB(177, 160, 199)
'                    .AutoFilterMode = False
'                    .Range("G2:H" & lastrow).Clear
'                    '*****************
'                    'Add Total Row with avgs ?
'                    'Add Footnote (Single/Dual Instructor color code)
'                    If InStr(ws.Name, "Avg") Then
'                        stCol = "A"
'                    Else
'                        stCol = "B"
'                    End If
'                    .Range(stCol & lastrow + 3) = "Single Instructor Instances"
'                    .Range(stCol & lastrow + 4) = "Dual Instructor Instances"
'                    .Range(stCol & lastrow + 3).Interior.Color = RGB(218, 150, 148) 'Pink
'                    .Range(stCol & lastrow + 4).Interior.Color = RGB(177, 160, 199) 'Purple
'                    .Range(stCol & lastrow + 3 & ":A" & lastrow + 4).Font.Size = 11
'                    .Range(stCol & lastrow + 3 & ":A" & lastrow + 4).Font.Bold = True
'                    .Range(stCol & lastrow + 3 & ":A" & lastrow + 4).WrapText = True
'                    '*****************
'
'            End Select
            .Range("A1").Select
        End With
        
    Next
exit_sub:
    wb.Worksheets(1).Activate
    'prepopulate file name so user knows whether this
    'is a course or conference spreadsheet.  Name can
    'be modified to another name as appropriate
    '20160405
    If Customize = "Course" Then
        Customize = "Course Results"
    ElseIf Customize = "AvgEvals" Then
        Customize = "Avg Results"
    ElseIf NewFile = False Then
        Customize = "New File Name"
    Else
        Customize = Filename
    End If
    FNameExists = False
fnameSave:
    Do While FNameExists = False
        FName = wb.Application.GetSaveAsFilename(InitialFileName:=Customize, filefilter:= _
                " Excel Macro Free Workbook (*.xlsx), *.xlsx", _
                FilterIndex:=2, title:="Save to a new workbook")
fnameReplace:
        If Dir(FName) = "" Then
            wb.SaveAs FName, FileFormat:=51
            FNameExists = True
        ElseIf FName = False Then
            MsgBox "File will not be saved", vbOKOnly + vbInformation, "Cancel SaveAs"
            wb.Close savechanges:=False
            FNameExists = True
        Else
            objapp.Visible = False
            yesno = MsgBox("File " & FName & " already exists.  Would you like to REPLACE this file? " & vbCrLf & vbCrLf & "Press No to choose another name; Cancel to quit without saving.", vbYesNoCancel, "File Exists")
            objapp.Visible = True
            If yesno = vbCancel Then
                wb.Close savechanges:=False
                FNameExists = True
            ElseIf yesno = vbYes Then
                Kill FName
                GoTo fnameReplace
            Else
                GoTo fnameSave
            End If
        End If
    Loop
    rs.Close
    rs1.Close
    Set rs = Nothing
    Set rs1 = Nothing
    Set db = Nothing
    objapp.Quit
    Set objapp = Nothing
End Sub