VBA Création d'un répertoire pour save .xls

Question

Bonjour,
voilà suite un ma macro en excel je voudrais savegarder des données dans un nouveau fichier exel mais à chaque fois que cette macro tournera je voudrais un créer un fichier avec un nom + la date du jour
mais aji un probleme lors de la création du répertoire! j'ai essayer avec mkdir ou sans !
je ne vois pas trop c'est la premiere fois que je dois utilisé se genre de traitement

ReDim Tableau(100)
'date du jour
DateJ = Now
NomDossier = "D:\XXXX\TEST" & DateJ & "/"

I = 3
J = 1
L = 3
NumProjetRef = Cells(I, 4).Value
NumtacheRef = Cells(I, 5).Value

While Cells(I, 4).Value <> ""

    While NumProjetRef = Cells(L, 4).Value And NumtacheRef = Cells(L, 5).Value
     
    NumArticle = Cells(L, 1).Value
    NumArticle = Left(NumArticle, 8)
    Tableau(J) = NumArticle
    
    If Cells(L, 7).Value <> "" Then
        NomDoc = Cells(L, 8).Value & " " & "/" & " " & Cells(I, 9).Value
    Else
        NomDoc = Cells(L, 4).Value & " " & "/" & "" & Cells(I, 5).Value
    End If
    L = L + 1
    J = J + 1
    Wend
    
    'On créer l'objet Excel
    Set xlApp = CreateObject("Excel.Application")
    'On défini le nombre d'onglets (ici 5)
    xlApp.SheetsInNewWorkbook = L
    'On ajoute un classeur
    Set xlBook = xlApp.Workbooks.Add
    'On donne un nom au classeur
    MkDir NomDossier
    xlBook.SaveAs NomDossier & NomDoc & ".xls"
    'On rend le classeur visible
    xlApp.Visible = True
    'On créer l'objet onglet dans le nouveau classeur créé
    For V = 1 To J
    Set xlSheet = xlBook.Worksheets(1)
    'On affecte un nom aux l'onglets
    xlSheet.Name = Tableau(V)
    'on libère l'objet onglet pour pouvoir en créer un nouveau ... etc
    Next V
    'On remet la propriété de l'application à 3 (par défaut)
    xlApp.SheetsInNewWorkbook = 3
    'On ferme l'application
    xlApp.Quit
    
    I = I + 1
    
Wend
End Sub

la partis en gras me génére l'erreur

merci de bien m'aider

wilfried_42 · Answer

Bonjour

j'ai un doute sur cette ligne : 
NomDossier = "D:\XXXX\TEST" & DateJ & "/"
pour moi ca serait :
NomDossier = "D:\XXXX\TEST" & DateJ & "\"

alors : 
NomDossier = "D:\XXXX\TEST" & DateJ
Ensuite : 
On error resume next ' Permet de ne pas planter si le dossier existe deja
MkDir NomDossier
On error Goto 0 ' On rend le control d'erreur à VBA
NomDossier = NomDossier & "\"

wilfried_42 · Answer

re:

reposte ta macro, modifiée avec ce que je t'ai donné

dy · Answer

'date du jour
DateJ = Now
NomDossier = "D:\XXXX\TEST" &" " &  DateJ

I = 3
J = 1
L = 3
NumProjetRef = Cells(I, 4).Value
NumtacheRef = Cells(I, 5).Value

While Cells(I, 4).Value <> ""

    While NumProjetRef = Cells(L, 4).Value And NumtacheRef = Cells(L, 5).Value
     
    NumArticle = Cells(L, 1).Value
    NumArticle = Left(NumArticle, 8)
    Tableau(J) = NumArticle
    
    If Cells(L, 7).Value <> "" Then
        NomDoc = Cells(L, 8).Value & " " & "/" & " " & Cells(I, 9).Value
    Else
        NomDoc = Cells(L, 4).Value & " " & "/" & "" & Cells(I, 5).Value
    End If
    L = L + 1
    J = J + 1
    Wend
    
    'On créer l'objet Excel
    Set xlApp = CreateObject("Excel.Application")
    'On défini le nombre d'onglets (ici 5)
    xlApp.SheetsInNewWorkbook = L
    'On ajoute un classeur
    Set xlBook = xlApp.Workbooks.Add
    'On donne un nom au classeur
    NomDossier = "D:\XXXX\TEST" & DateJ

    On Error Resume Next ' Permet de ne pas planter si le dossier existe deja
    MkDir NomDossier
    On Error GoTo 0 ' On rend le control d'erreur à VBA
    NomDossier = NomDossier & "\"

    xlBook.SaveAs NomDossier & NomDoc & ".xls"
    'On rend le classeur visible
    xlApp.Visible = True
    'On créer l'objet onglet dans le nouveau classeur créé
    For V = 1 To J
    Set xlSheet = xlBook.Worksheets(1)
    'On affecte un nom aux l'onglets
    xlSheet.Name = Tableau(V)
    'on libère l'objet onglet pour pouvoir en créer un nouveau ... etc
    Next V
    'On remet la propriété de l'application à 3 (par défaut)
    xlApp.SheetsInNewWorkbook = 3
    'On ferme l'application
    xlApp.Quit
    
    I = I + 1
    
Wend
End Sub

teins

wilfried_42 · Answer

tu as des caracteres qui ne vont pas dans le chemin

DateJ = Date
NomDossier = "D:\XXXX\TEST" &" " &  Format(DateJ,"dd-mm-yyyy")

ensuite : 

    If Cells(L, 7).Value <> "" Then
        NomDoc = Cells(L, 8).Value & " - " & Cells(I, 9).Value
    Else
        NomDoc = Cells(L, 4).Value & " - " & Cells(I, 5).Value
    End If

Utilisateur anonyme · Answer

Bonjour,

Au moment de la création d'un dossier, il faut s'assurer d'être au bon endroit.
J'entends par là, sur le bon lecteur.

Suggestion :


Sub Creer_Dossier()

    Dim NomDossier As String
    Dim Lecteur As String

    NomDossier = "C:\Document\TEST" & " " & Format(Date, "dd-mm-yyyy")
    MsgBox NomDossier
    Lecteur = Mid(NomDossier, 1, 2)
    ChDrive Lecteur
    MkDir NomDossier

End Sub
'


Ce code est testé sous Office 2003 et WXP.

Lupin

VBA Création d'un répertoire pour save .xls

5 réponses

Discussions similaires

Newsletters