VBA Access Import Excel dans Access - VB/VBA/VBS - Programmation
Marsh Posté le 22-05-2006 à 15:19:51
Bonjour à tous,
après voir tout testé, mon fichier excel, debugger pas à pas, j'en suis venu à la conclusion suivante, et j'en suis presque sûr:
Le pb vient de ma boucle. En fait il reste toujours sur le même fichier et c'est ça qui fait planté le programme.
Quelqu'un sur le forum, n'aurait-il pas essayer de lire plusieurs fichiers sur un répertoire, et quel méthode (quel test de boucle) a-t-il adopté pour faire cela ?
D'avance merci à tous
Marsh Posté le 22-05-2006 à 17:43:28
A adapter
Sub ListeFichiersTableau()
Dim NomFichier As String, NomFichierSansExtension As String
Dim Dossier As String, NbFichiers As Integer, Pos As Integer
Dim Tableau() As String, i As Integer
' Dossier de test
Dossier = "C:\Transfert\*.*"
NomFichier = Dir(Dossier)
Cells.Clear
Erase Tableau
NbFichiers = 0
Do While Len(NomFichier) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Pos = InStr(1, NomFichier, ".", 1)
NomFichierSansExtension = Left(NomFichier, Pos - 1)
Tableau(NbFichiers) = NomFichierSansExtension
NomFichier = Dir()
Loop
If NbFichiers > 0 Then
For i = 1 To UBound(Tableau)
Cells(i + 1, 1) = Tableau(i)
Next
End If
End Sub
Marsh Posté le 22-05-2006 à 19:48:44
Merci pour ton aide kiki29, malheureusement je n'arrive pas à faire fonctionner cela avec mon code, je pense que je vais devoir faire autrement, désolé...
merci de ton aide, @+
Marsh Posté le 19-05-2006 à 17:09:36
Bonjour,
J'importe dans une base access des fichiers excel situés sur un répertoire.
Le programme me fait bien l'import des données dans ma base access, simplement lors du traitement de
plusieurs fichiers le programme bug en ouvrant la fenêtre suivante:
Fichier désormais disponible
"toto.xls" est à présent disponible pour modification
Ouvrez le fichier en lecture-écriture pour le modifier
Je suis alors obligé de tuer les processus excel pour retrouver un état normal
quelqu'un aurait-il une idée ???
D'avance merci
ci joint mon code:
Sub ImportAllFiles()
'Supprimer enreg table T_Import_Brut
DoCmd.RunSQL "DELETE FROM TImportTable1"
DoCmd.RunSQL "DELETE FROM TImportTable2"
DoCmd.RunSQL "DELETE FROM TImportTable3"
DoCmd.RunSQL "DELETE FROM TImportTable4"
DoCmd.RunSQL "DELETE FROM TImportTable5"
DoCmd.RunSQL "DELETE FROM TBTable6"
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\Import\"
Fichier = Dir(Repertoire & "*.xls" )
Do While Fichier <> ""
strPathToFiles = Repertoire & Fichier
Set xlAppl = CreateObject("Excel.Application" )
Set wb = xlAppl.Workbooks.Open(strPathToFiles)
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, "TImportTable1", strPathToFiles, False, onglet & "!H1:L201"
DoCmd.TransferSpreadsheet acImport, 8, "TImportTable2", strPathToFiles, False, onglet & "!H202:L291"
DoCmd.TransferSpreadsheet acImport, 8, "TImportTable3", strPathToFiles, False, onglet & "!H292:L328"
DoCmd.TransferSpreadsheet acImport, 8, "TImportTable4", strPathToFiles, False, onglet & "!H338:M344"
DoCmd.TransferSpreadsheet acImport, 8, "TImportTable5", strPathToFiles, False, onglet & "!H345:L352"
ElseIf onglet = "TransposeB" Then
' transfert vers table T_Import_IG
DoCmd.TransferSpreadsheet acImport, 8, "TBTable6", strPathToFiles, False, onglet & "!A1:F"
End If
End If
Next ws
wb.Close
xlAppl.Quit
Set wb = Nothing
Set xlAppl = Nothing
Fichier = Dir
Loop
En sub