Export to excel from ADO, and change the names of a columns

[Fraps]

Hi,
is there any possible to change the names of a columns exporting data to excel from mdb file.

I would like to change "AD" column in mdb to "Index" in Excel. Of course I could change the names in mdb but some of them are very long, and ADO cannot get it.

I mean how to change in excel Field Name from ADO

Thanks

[sansknowledge]

i think you can change the cell values by creating excel worksheet objects and can access each cell individually i hope it might show you some way or other :-)

[Fraps]

That's right I would like to change the cell names in Excel document. They should be different than in mdb file. Do you have any example for that?

Thanks

[abhijit]

That's right I would like to change the cell names in Excel document. They should be different than in mdb file. Do you have any example for that?

Thanks

How are you doing the export? Could you post your code?
If you are using the built-in feature to export, the column names will not change.

[Fraps]

Hi abhijit

here below is my code ( class module ):

Public Sub ExportToExcel(Optional SaveFile As Boolean = False, _
                         Optional VisibleInstance As Boolean = True, _
                         Optional Password As String = "", _
                         Optional WriteResPassword As String = "", _
                         Optional ReadOnlyRecommended As Boolean = False, _
                         Optional HeaderFont As String = "Tahoma", _
                         Optional HeaderFontSize As Integer = 9)

Dim iRowIndex As Integer, avRows As Variant, ErrorOccured As Boolean
Dim iFieldCount As Integer, objExcel As Object, objTemp As Object
Dim iColIndex As Integer, iRecordCount As Integer

'I know that some tweaking are left here... I gave priority to compability here

    On Error GoTo hell

    RaiseEvent ExportStarted(EXCEL)

    With ADODBRecordset
        .MoveFirst
        avRows = .GetRows()                  'Read all the records in an
        iRecordCount = UBound(avRows, 2) + 1 'array and determine how
        iFieldCount = UBound(avRows, 1) + 1  'many fields in an array
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Visible = VisibleInstance
        objExcel.Workbooks.Add

        Set objTemp = objExcel           'Ensure excel remains visible

        If Val(objExcel.Application.Version) >= 8 Then
            Set objExcel = objExcel.ActiveSheet
        End If

        iRowIndex = 1

        'Place Name of the fields
        For iColIndex = 1 To iFieldCount
            With objExcel.Cells(iRowIndex, iColIndex)
                .Value = ADODBRecordset.Fields(iColIndex - 1).Name
                With .Font
                    .Name = HeaderFont      'Make the headers stand out
                    .Size = HeaderFontSize
                    .Bold = True
                End With
            End With
        Next iColIndex

    End With

    With Progress
        .Min = 0
        .Max = ADODBRecordset.RecordCount
        .Value = 0
    End With

    With objExcel
        
        For iRowIndex = 2 To iRecordCount + 1
            For iColIndex = 1 To iFieldCount
                .Cells(iRowIndex, iColIndex) = avRows(iColIndex - 1, iRowIndex - 2)
            Next iColIndex
            Progress.Value = Progress.Value + 1
            DoEventsEx
        Next iRowIndex
        .Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
        If SaveFile Then
            .SaveAs ExportFilePath, , Password, WriteResPassword, ReadOnlyRecommended
        End If
    End With
    
    If Not VisibleInstance Then objExcel.Application.Quit
    Set objTemp = Nothing
    Set objExcel = Nothing
    
    RaiseEvent ExportComplete(Not ErrorOccured, EXCEL)

Exit Sub

hell:
    RaiseEvent ExportError(Err, EXCEL)
    If Err.Number = 0 Then
        Resume Next
        ErrorOccured = True
    End If

End Sub

Export to excel sheet works very well, only what I wanna do is to change the cell names in excel on A1, B1, C1, and so on.

And this is my sheet. Is there any way to change the cells showed above as ID, CM1, CM2 for Index, Index2...

Regards.

[sansknowledge]

Mr.Fraps if i understand correct you almost had it, you just a need a function which gets the header name and return another name of your choice in or you can do like this

Dim tempval As Integer
tempval = 65
        'Place Name of the fields
        For iColIndex = 1 To iFieldCount
            With objExcel.Cells(iRowIndex, iColIndex)
                '.Value = ADODBRecordset.Fields(iColIndex - 1).Name
                .Value = CStr(Chr(tempval)) & 1
                With .Font
                    .Name = HeaderFont      'Make the headers stand out
                    .Size = HeaderFontSize
                    .Bold = True
                End With
            End With
            tempval = tempval + 1
        Next iColIndex

a little tweaking required if z1 occurs you have to reset the tempval and convert the static 1 to a variable to hold 1 and increase once 26
HTH

[Fraps]

Thanks for the suggestions.

Public Sub ExportToExcel(Optional SaveFile As Boolean = False, _
                         Optional VisibleInstance As Boolean = True, _
                         Optional Password As String = "", _
                         Optional WriteResPassword As String = "", _
                         Optional ReadOnlyRecommended As Boolean = False, _
                         Optional HeaderFont As String = "Tahoma", _
                         Optional HeaderFontSize As Integer = 9)

Dim iRowIndex As Integer, avRows As Variant, ErrorOccured As Boolean
Dim iFieldCount As Integer, objExcel As Object, objTemp As Object
Dim iColIndex As Integer, iRecordCount As Integer

'I know that some tweaking are left here... I gave priority to compability here

    On Error GoTo hell

    RaiseEvent ExportStarted(EXCEL)

    With ADODBRecordset
        .MoveFirst
        avRows = .GetRows()                  'Read all the records in an
        iRecordCount = UBound(avRows, 2) + 1 'array and determine how
        iFieldCount = UBound(avRows, 1) + 1  'many fields in an array
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Visible = VisibleInstance
        objExcel.Workbooks.Add

        Set objTemp = objExcel           'Ensure excel remains visible

        If Val(objExcel.Application.Version) >= 8 Then
            Set objExcel = objExcel.ActiveSheet
        End If

        iRowIndex = 1

        'Place Name of the fields
        For iColIndex = 1 To iFieldCount
            With objExcel.Cells(iRowIndex, iColIndex)
                .Value = ADODBRecordset.Fields(iColIndex - 1).Name
                With .Font
                    .Name = HeaderFont      'Make the headers stand out
                    .Size = HeaderFontSize
                    .Bold = True
                    
                    objExcel.Cells.Range("A1").Value = "Index" 
                    objExcel.Cells.Range("B1").Value = "Index2" 
                    objExcel.Cells.Range("C1").Value = "Index3" 
                    objExcel.Cells.Range("D1").Value = "Index4" 

                    
                End With
            End With
        Next iColIndex

    End With

    With Progress
        .Min = 0
        .Max = ADODBRecordset.RecordCount
        .Value = 0
    End With

    With objExcel
        
        For iRowIndex = 2 To iRecordCount + 1
            For iColIndex = 1 To iFieldCount
                .Cells(iRowIndex, iColIndex) = avRows(iColIndex - 1, iRowIndex - 2)
            Next iColIndex
            Progress.Value = Progress.Value + 1
            DoEventsEx
        Next iRowIndex
        .Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
        If SaveFile Then
            .SaveAs ExportFilePath, , Password, WriteResPassword, ReadOnlyRecommended
        End If
    End With
    
    If Not VisibleInstance Then objExcel.Application.Quit
    Set objTemp = Nothing
    Set objExcel = Nothing
    
    RaiseEvent ExportComplete(Not ErrorOccured, EXCEL)

Exit Sub

hell:
    RaiseEvent ExportError(Err, EXCEL)
    If Err.Number = 0 Then
        Resume Next
        ErrorOccured = True
    End If

End Sub

I've just put something like this in the middle of the above listing
objExcel.Cells.Range("A1").Value = "Index"
.......................
.......................

The case resolved thanks