Archiver des exports Excel dans une base Access Résolu

Question

bonjour,

Dans access 365, travail sur des exports.

Ce que je souhaite réaliser dans un premier temps,

Archiver dans une table access les exports se trouvant dans un répertoire de mon serveur.

Ma configuration :

J'ai une table "Liste_Fichiers_Exports" c'est la que je souhaite enregistrer les libellés des exports en alimentant 5 champs comme suit :

1 Champ => libelle de l'export
2 Champ => jj/mm/aaaa
3 Champ => N° Semaine
4 Champ => Année
5 Champ => Chemin du répertoire de l'export

J'ai une requête "R_Repertoire" ou se trouve le champ "Rep_Fichier" c'est la que j'indique le chemin des exports à prendre.

Les exports sont toujours libellés comme suit : 20170608_EXPORT.csv

J'ai la procédure vba qui fonctionne dans un fichier Excel et je souhaite adapter cette procédure dans une base de données Access
et la je suis coullé car je ne connais pas beaucoup le DAO, recordset...

Si quelqu'un pouvait m'aider, un grand merci.

Le code Excel, la seule chose qui change c'est le chemin du réperoire des exports qui est indiqué sur l'onglet "Paramètres" en cellule B11
et l'onglet "Listes_fichiers_Exports" ou sont stockés les libellés des exports.

Option Base 1
Sub liste_Fichiers_Exports()

Dim base_fichiers()

Set feuille = Worksheets("Paramètres")
rep = feuille.Range("b11")

fichier = Dir(rep)

i = 1
While fichier <> ""
ReDim Preserve base_fichiers(5, i)

If Right(fichier, 9) = "EXPORTS.csv" Then

base_fichiers(1, i) = fichier
ma_date = DateSerial(Left(fichier, 4), Mid(fichier, 5, 2), Mid(fichier, 7, 2))

base_fichiers(2, i) = Format(ma_date, "mm/dd/yyyy")
base_fichiers(3, i) = Format(ma_date, "ww", vbMonday, vbFirstFullWeek)

base_fichiers(5, i) = rep & fichier

'corrige 1ere semaine - de 4 jours
correction = False
If Month(ma_date) = 1 And Format(ma_date, "ww", vbMonday, vbFirstFourDays) > 50 Then
    mon_annee_corrigee = Year(ma_date) - 1
    correction = True
End If

'corrige 1ere semaine + de 4 jours
If Month(ma_date) = 12 And Format(ma_date, "ww", vbMonday, vbFirstFourDays) < 5 Then
    mon_annee_corrigee = Year(ma_date) + 1
    correction = True
End If

If correction = False Then mon_annee_corrigee = Year(ma_date)

base_fichiers(4, i) = mon_annee_corrigee

i = i + 1
End If

fichier = Dir

Wend

Set feuille = Worksheets("Liste_Fichiers_Exports")
feuille.Cells.Clear

feuille.Range("A1").Resize(UBound(base_fichiers, 2), UBound(base_fichiers, 1)) = Application.Transpose(base_fichiers)

End Sub

AstraLife · Answer

J'ai trouvé comment vider la table, :-(



Sub Liste_Fichiers_Exports()Dim oRst As DAO.RecordsetDim oDb As DAO.DatabaseSet oDb = CurrentDbSet oRst = oDb.TableDefs("Liste_Fichiers_Exports").OpenRecordsetWhile Not oRst.EOF  oRst.Delete  oRst.MoveNextWendEnd Sub

AstraLife · Answer

J'y suis pas loin, je ne sais pas comment interpréter la fonction transpose d'Excel sur Access.

Mon code

Sub Liste_Rep_Export()

Dim base_fichiers()

Dim oDb As DAO.Database
Dim oRst As DAO.Recordset
Dim Rep_Motam As String

Set oDb = CurrentDb
Set oRst = oDb.OpenRecordset("R_Repertoire")

Rep_Export = oRst![Rep_Export]

fichier = Dir(Rep_Export)

i = 1
While fichier <> ""
ReDim Preserve base_fichiers(5, i)

If Right(fichier, 9) = "EXPORT.csv" Then

base_fichiers(1, i) = fichier
ma_date = DateSerial(Left(fichier, 4), Mid(fichier, 5, 2), Mid(fichier, 7, 2))

base_fichiers(2, i) = Format(ma_date, "mm/dd/yyyy")
base_fichiers(3, i) = Format(ma_date, "ww", vbMonday, vbFirstFullWeek)

base_fichiers(5, i) = Rep_Export & fichier

'corrige 1ere semaine - de 4 jours
correction = False
If Month(ma_date) = 1 And Format(ma_date, "ww", vbMonday, vbFirstFourDays) > 50 Then
    mon_annee_corrigee = Year(ma_date) - 1
    correction = True
End If

'corrige 1ere semaine + de 4 jours
If Month(ma_date) = 12 And Format(ma_date, "ww", vbMonday, vbFirstFourDays) < 5 Then
    mon_annee_corrigee = Year(ma_date) + 1
    correction = True
End If

If correction = False Then mon_annee_corrigee = Year(ma_date)

base_fichiers(4, i) = mon_annee_corrigee

i = i + 1
End If

oRst.Close: Set oRst = Nothing
oDb.Close: Set oDb = Nothing

fichier = Dir

Wend

Set oDb = CurrentDb
Set oRst = oDb.TableDefs("Liste_Fichiers_Exports").OpenRecordset

While Not oRst.EOF
  oRst.Delete
  oRst.MoveNext

Wend

End Sub

'Partie d'excel que je n'arrive pas à appliquer en vba Access
feuille.Range("A1").Resize(UBound(base_fichiers, 2), UBound(base_fichiers, 1)) = Application.Transpose(base_fichiers)

Archiver des exports Excel dans une base Access

2 réponses

Discussions similaires

Newsletters