Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Tester si répertoire existe et le créer si non


Sujet :

Macros et VBA Excel

  1. #1
    Futur Membre du Club
    Profil pro
    Inscrit en
    septembre 2008
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : septembre 2008
    Messages : 11
    Points : 7
    Points
    7
    Par défaut Tester si répertoire existe et le créer si non
    Hello tlm,

    J'ai un bouton dans un formulaire qui à pour fonction:
    1. Contrôler si le dossier destination existe
    2. S'il n'existe pas le créer
    3. faire une copie de mon fichier et le sauver sous un chemin x
    4. renommer et sauver le fichier ouvert dans le répertoire existant ou créé
    5. S'il existe déjà, juste faire la copie et la sauvegarde
    6. Envoi du fichier par mail

    Voici mon code:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    Sub Button269_Click()
    'Check dir and created if necessary, Save & Send the renamed file by email '
     
     
    If (Dir("C:\Windows\Temp\repertoir_stockage")) <> "repertoir_stockage" Then
    MkDir ("C:\Windows\Temp\repertoir_stockage")
     
    ActiveWorkbook.SaveCopyAs filename:="C:\Windows\Temp\" & Range("B7").Value & "_" & Range("I8").Value & "_eShell_order.xls"
    ActiveWorkbook.SaveAs filename:="C:\Windows\Temp\Phonak_eShell\" & Range("B7").Value & "_" & Range("I8").Value & "_eShell_order.xls"
    Else
    End If
     
    Dim ol As Object, myItem As Object
    Set ol = CreateObject("outlook.application")
    Set myItem = ol.CreateItem(olMailItem)
    myItem.to = "moi@mail.com"
    myItem.Subject = "German acoustician order form"
    myItem.Body = "voici le fichier de stockage"
    'fichier en cours d'utilisation envoyé en attaché:
    myItem.Attachments.Add ActiveWorkbook.FullName
    myItem.Send
    Set ol = Nothing
     
    End Sub
    Cela fonctionne très bine à la première execution mais si je l'execute à nouveau ça plante sur: MkDir ("C:\Windows\Temp\repertoir_stockage") car il existe déjà du coup.

    Comme lui dire s'il existe déja juste faire:

    La copie, renommage et sauvegarde
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    ActiveWorkbook.SaveCopyAs filename:="C:\Windows\Temp\" & Range("B7").Value & "_" & Range("I8").Value & "_eShell_order.xls"
    ActiveWorkbook.SaveAs filename:="C:\Windows\Temp\Phonak_eShell\" & Range("B7").Value & "_" & Range("I8").Value & "_eShell_order.xls"
    Et l'envoi par mail en attachment:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Dim ol As Object, myItem As Object
    Set ol = CreateObject("outlook.application")
    Set myItem = ol.CreateItem(olMailItem)
    myItem.to = "moi@mail.com"
    myItem.Subject = "German acoustician order form"
    myItem.Body = "voici le fichier de stockage"
    'fichier en cours d'utilisation envoyé en attaché:
    myItem.Attachments.Add ActiveWorkbook.FullName
    myItem.Send
    Set ol = Nothing
    Merci d'avanc epour votre aide!

  2. #2
    Membre confirmé
    Profil pro
    Inscrit en
    juillet 2004
    Messages
    533
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2004
    Messages : 533
    Points : 548
    Points
    548
    Par défaut
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
    If Dir("U:\Toto", vbDirectory) <> "" Then 
                   'Ton fichier U:\Toto existe donc pas la peine de le créer

  3. #3
    Inactif  

    Profil pro
    Inscrit en
    juillet 2007
    Messages
    4 555
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2007
    Messages : 4 555
    Points : 5 566
    Points
    5 566
    Par défaut
    Bonjour,

    ceci te créera le répertoire c:\toto\titi\tata\, y compris ses sous-répertoires, que s'il le faut (que ce qu'il faut) , sans la moindre faille :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
     
    Private Sub Command1_Click()
     SHCreateDirectoryEx 0, "c:\toto\titi\tata\", ByVal 0&
    End Sub

  4. #4
    Membre confirmé
    Profil pro
    Inscrit en
    juillet 2004
    Messages
    533
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2004
    Messages : 533
    Points : 548
    Points
    548
    Par défaut
    Interessant comme solution.. je ne connaissais pas

    Pas sur que cette fonction soit forcément présente sur toutes les installations ==> attention à ce genre de truc....

  5. #5
    Membre actif
    Profil pro
    chomeur
    Inscrit en
    août 2006
    Messages
    340
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : chomeur

    Informations forums :
    Inscription : août 2006
    Messages : 340
    Points : 246
    Points
    246
    Par défaut
    bonjour a tous,

    j'apporte encore une autre solution, juste pour la forme:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    Sub tt()
    'Il ne faut pas oublier de rajouter la réference
    'Miscrosoft Scripting runtime
     
    Dim fso As FileSystemObject
    Dim fsoMonDossier As Folder
    Dim stMonChemin As String
     
    stMonChemin = "c:\temp\monchemin"
     
    Set fso = New FileSystemObject
     
    If Not fso.FolderExists(stMonChemin) Then
      Set fsoMonDossier = fso.CreateFolder(stMonChemin)
    End If
     
    End Sub

Discussions similaires

  1. tester si un répertoire existe
    Par alaninho dans le forum Général Python
    Réponses: 3
    Dernier message: 19/05/2011, 23h02
  2. Tester si un fichier existe et le créer sinon
    Par tonixm dans le forum Langage
    Réponses: 2
    Dernier message: 23/05/2008, 14h36
  3. Réponses: 2
    Dernier message: 02/01/2007, 16h43
  4. [VBS] Tester plusieurs répertoire avec un seul If
    Par Edoxituz dans le forum VBScript
    Réponses: 38
    Dernier message: 25/02/2006, 21h18
  5. Tester si fenêtre existe après submit
    Par ronald dans le forum Général JavaScript
    Réponses: 6
    Dernier message: 06/01/2005, 17h36

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo