Problem in a recordset

[nilses]

Hello,

I have a problem with my code to export ma query from Access to Excel. I have a cross table with 2 fields and 2 records. In my recordset, would like to keep my second field but in ica't do it.

My table is like this:

field 1....field 2
Type | 1
---------------
D | 2618
DT | 207

I would like to have in my recordset just the field 2 but i don't want tu use a query to keep the field 2 because the name change sometimes.

This is my code:

Sub TransfertToExcel()
      
        Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim fichier As Variant
        Dim stAppName As String
        
        fichier = Application.CurrentProject.Path
        
        Set db = DBEngine.OpenDatabase(fichier & "\Hot_Line.mdb")
        Set rs = db.OpenRecordset("QryDataBase", dbOpenDynaset)
        
        Dim XL_App As Object
        Set XL_App = CreateObject("Excel.Application")
        Dim XL_classeur As Object
        Dim XL_feuille As Object
        Dim Rg As Range
        Dim Nb As Long
        Dim Sh As Worksheet
                
        With XL_App
            Set XL_classeur = .Workbooks.Open(fichier & "\Result.xls")
            Set Sh = XL_classeur.Sheets("Country")
            
            With Sh
            Set Rg = .Range("P7").End(xlToRight).Offset(0, 1)
            End With
            
            'Rg.CurrentRegion.Clear
                        
            If rs.EOF = False Then

// In line below, i would like to keep the second field but how can i do ?
I have try this but it doesn't work and it 's not the good method
 Rg.Offset(0).CopyFromRecordset rs(0,2)
 
                Rg.Offset(0).CopyFromRecordset rs
                Rg.CurrentRegion.EntireColumn.AutoFit
                Rg.CurrentRegion.WrapText = True
                Rg.CurrentRegion.BorderAround bordure, xlHairline, 0
                Rg.CurrentRegion.Borders.LineStyle = xlContinuous
                Rg.CurrentRegion.HorizontalAlignment = xlHAlignCenter
                Rg.CurrentRegion.VerticalAlignment = xlVAlignCenter
            Else
                MsgBox "Aucun enregistrement trouvé."
            End If
            
            .DisplayAlerts = False
            .ActiveWorkbook.Save
            .ActiveWorkbook.Close
            .DisplayAlerts = True
            .Quit
            
        End With
        
        db.Close
        XL_App.Quit
        Set XL_App = Nothing
        Set XL_classeur = Nothing
        Set XL_feuille = Nothing

End Sub

 

[nilses]

Oups, thanks you for your help,

Nilses