Problème pour exporter une table ACCESS vers

Bonjour à tous,



J'ai un petit problème concernant l'exportation d'une table ACCESS vers EXCEL.

Je veux exporter la table "T31_Cumul_Nvx_clients_par_BG" dans la feuille "S0" du fichier EXCEL "Nvx clients par BG 2006 S14.xls".

Dans la table ACCESS il ya le champ le champ "semaine" composé de 2 chiffres, ces 2 chiffres je veux les recupérer pour copier la feuille "S0" pour en faire une "Sxx", je veux également mettre les différents champs dans les feuilles EXCEL.

Puis enfin je veux mettre dans la feuille "Semaine S-1" les données de la feuille "Sxx -1" celle de la semaine précédente.



Pour l'instant j'ai un petit problème avec une fois sur deux cette erreur "462-Le serveur distant n'existe pas ou n'est pas disponible"

Voici pour l'instant mon code:



Option Compare Database



Global Const RepertoireTableauBord As String = "C:\Documents and Settings\A4382\Bureau\stage\"

Global Const Titre As String = "Suivi Conquête "

Dim erreur_traitement As Boolean

Sub ExportTblAccessInExcel()



Dim Db As DAO.Database

Dim Rs As DAO.Recordset

Dim Xlapp As Excel.Application

Dim XlBook As Excel.Workbook

Dim XlSheet As Excel.Worksheet



On Error GoTo errOuvrirExcel

Set Xlapp = GetObject(, "Excel.Application")

On Error GoTo oups:

Xlapp.Visible = True



Set XlBook = Xlapp.Workbooks.Open("C:\Documents and Settings\A4382\Bureau\stage\Nvx clients par BG 2006 S14.xls")

Set XlSheet = XlBook.Worksheets("S0")

Set appexcel = New Excel.Application

Numsemaine = "S0"

' efface les données

XlSheet.Cells.Clear

Set Db = CurrentDb

' Copie dans S0

Set Rs = Db.OpenRecordset("T31_Cumul_Nvx_clients_par_BG", , dbOpenForwardOnly)

XlSheet.Range("A1").CopyFromRecordset Rs

Set XlSheet = Nothing

' Ajout de la feuille

Sheets("S0").Select

Sheets("S0").Copy Before:=Sheets(18)

Sheets("S15").Select

ActiveWindow.SelectedSheets.Delete

Sheets("S0 (2)").Select

Sheets("S0 (2)").Name = "S15"

Sheets("_S15").Select

ActiveWindow.SelectedSheets.Delete

' remise au début car le 'CopyFromRecordset' ne le fait pas

Rs.MoveFirst

XlSheet.Range("A1").CopyFromRecordset Rs



' Ferme les Var

Rs.Close: Set Rs = Nothing

Db.Close: Set Db = Nothing

Set XlSheet = Nothing

' Sauve le fichier

XlBook.Save

XlBook.Close

Set XlBook = Nothing

Set Xlapp = Nothing



Exit Sub

errOuvrirExcel:

'Err 429 : Un serveur OLE Automation ne peut pas créer d'objet

' -> Excel n'est PAS encore ouvert.

If Err = 429 Then

Set Xlapp = CreateObject("Excel.Application")

Resume Next

End If

oups:

MsgBox Err.Number & " - " & Err.Description

End Sub





Merci à vous pour votre aide