Export donnée Access

[Jacques]

Bonjour le forum,

Lorsque je lance ce module Exportation de Table l’erreur suivante se produit :

« Erreur 1004 Impossible de renommer une feuille comme une autre feuille, une bibliothèque d’objet référencée ou un classeur référencé par visual basic »
Et le programme s’arrête a cette ligne « xls.Name= Rencontres »

Je vous remercie pour votre aide

Ci après mon module :

Function ExportationExcel()

Dim xlApp As Excel.Application 'Application Excel
Dim xlw As Excel.Workbooks 'Classeur Excel
Dim xls As Excel.Worksheet 'Feuille Excel
Dim Db As DAO.Database
Dim Rs As DAO.Recordset
Dim rq As String
Dim varFichier As Variant
Dim strFichier As String
Dim fd As FileDialog
Dim intI As Integer

'--- Ouverture de la base
Set Db = CurrentDb
'--- Ouverture de la tbl Excel
rq = 'select * from [tbl Excel]'
Set Rs = Db.OpenRecordset(rq, dbOpenDynaset)
'--- Préparer la boîte de dialogue Ouvrir
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = 'Choisissez un document'
fd.InitialFileName = '*.doc'
fd.InitialFileName = '*.*'
fd.AllowMultiSelect = True
'--- Personnaliser la liste déroulante Type de fichier
fd.Filters.Clear
fd.Filters.Add 'Tous les fichiers', '*.*'
fd.Filters.Add 'Fichiers Excel', '*.doc'
fd.FilterIndex = 0
'--- Ouvrir la boîte de dialogue
If fd.Show = 0 Then
'--- L'action a été annulée
Set fd = Nothing
Exit Function
End If
'--- Passer à la partie Exportation et Ouverture de l'application
Set xlApp = CreateObject('Excel.Application')
xlApp.Visible = True
'--- Ouvrir chaque document sélectionné et le traiter
For Each varFichier In fd.SelectedItems
xlApp.Workbooks.Open (varFichier)
Next
'--- Nommer la feuille par défaut
Set xls = xlApp.ActiveSheet
xls.Name = 'Rencontres'
'--- Vide la feuille de son contenu
With xls
.Cells.ClearContents
End With
'--- Désactiver les messages de confirmation d'Excel
xlApp.DisplayAlerts = False
'--- Ecrire des en-têtes
For intI = 0 To Rs.Fields.Count - 1
xls.Cells(1, intI + 1).Value = Rs.Fields(intI).Name
Next
'--- Transfert de données
xlApp.Range('A2').CopyFromRecordset Rs
'--- Désallocation mémoire
Set xlApp = Nothing
Set xls = Nothing
Set xlw = Nothing
End Function

A plus

Jacques