Import excel

[Roland]

Bonjour à tous,

Je voudrai effectuer un import de plusieurs fichiers excel dans une base access.

Ces fichiers excel se situent dans un répertoire spécifique.

Je n'arrive pas à spécifier se répertoire dans mon code. J'ai essayer plusieurs syntaxes...
Je me résigne donc à exposer mon pb du fait que je cherche depuis pas mal de temps

voici mon code que j'ai placé dans un module access:

Sub ImportAllFiles()

Dim strPathToFiles As String
Dim xlAppl As New Excel.Application
Dim onglet As String
Dim ws As Excel.Worksheet
Dim listeOnglet As String

'mon pb se situe ici ?
strPathToFiles = '...\\...\\...\\...\\'

'Supprimer enreg table T_Import_Brut
DoCmd.RunSQL 'DELETE FROM TImport'
DoCmd.RunSQL 'DELETE FROM TImport2'

'mon pb se situe ici ?
xlAppl.Workbooks.Open FileName:=strPathToFiles, ReadOnly:=True

rootxl = xlAppl.Workbooks.Application.ActiveWorkBook.Path

For Each ws In xlAppl.Worksheets
If ws.Visible = True Then
onglet = ws.Name
Debug.Print onglet

If onglet = 'TestIndicateurs' Then

' transfert vers table T_Import_Brut
DoCmd.TransferSpreadsheet acImport, 8, 'TImport', strPathToFiles, False, onglet & '!H2:L201'


ElseIf onglet = 'Transpose' Then

' transfert vers table T_Import_IG
DoCmd.TransferSpreadsheet acImport, 8, 'TImport2', FileName, False, onglet & '!A1:F'


End If

End If

Next ws

xlAppl.Application.DisplayAlerts = False
xlAppl.Application.Quit

Set xlAppl = Nothing

End Sub


Merci à tous pour votre aide

 

[MichelXld]

Bonsoir Roland

cet exemple permet de boucler sur tous les classeurs d'un répertoire

Dim Repertoire As String, Fichier As String

Repertoire = 'C:\\\\\\\\Documents and Settings\\\\\\\\michel\\\\\\\\dossier\\\\\\\\'
Fichier = Dir(Repertoire & '*.xls')
Do While Fichier ‹› ''

Debug.Print Repertoire & Fichier

Fichier = Dir
Loop


je n'ai pas testé mais cela pourrait donner dans ta procedure :


Sub ImportAllFiles()
Dim strPathToFiles As String
Dim xlAppl As Excel.Application
Dim Wb As Excel.Workbook
Dim onglet As String
Dim ws As Excel.Worksheet
Dim Repertoire As String, Fichier As String

Repertoire = 'C:\\\\\\\\Documents and Settings\\\\\\\\michel\\\\\\\\dossier\\\\\\\\'

Fichier = Dir(Repertoire & '*.xls')
Do While Fichier ‹› ''

Set xlAppl = CreateObject('Excel.Application')
strPathToFiles = Repertoire & Fichier

'Supprimer enreg table T_Import_Brut
DoCmd.RunSQL 'DELETE FROM TImport'
DoCmd.RunSQL 'DELETE FROM TImport2'

Set Wb = xlAppl.Workbooks.Open(FileName:=strPathToFiles, ReadOnly:=True)

For Each ws In Wb.Worksheets
If ws.Visible = True Then
onglet = ws.Name

If onglet = 'TestIndicateurs' Then

' transfert vers table T_Import_Brut
DoCmd.TransferSpreadsheet acImport, 8, 'TImport', strPathToFiles, False, onglet & '!H2:L201'

ElseIf onglet = 'Transpose' Then

' transfert vers table T_Import_IG
DoCmd.TransferSpreadsheet acImport, 8, 'TImport2', strPathToFiles, False, onglet & '!A1:F'

End If
End If
Next ws

Wb.Close False
setwb = Nothing
xlAppl.Quit
Set xlAppl = Nothing

Fichier = Dir
Loop
End Sub


(tu auras sans doute des réponses mieux adaptées sur un forum Access)



bonne soirée
MichelXld

 

[Roland]

Merci d'avoir regarder mon pb, même si cela ne relevait pas directement d'Excel.

Ton algo marche très bien, et le chemin spécifier correspond exactement à ma question.

J'ai encore un souci de comportement aléatoire d'alimentation, lié surement à mon application.

J'avais effectivement essayer de poser la question sur un forum access mais aucune réponse depuis 3 semaines... Si tu as des adresses de forum access vba aussi réactif et stable que celui-ci je suis preneur !!!

Merci encore, @+

 

[MichelXld]

bonjour Roland

j'espere que ces liens pourront t'aider

http://access.developpez.com/




bon apres midi
MichelXld