probleme de macro excel 2007 et pas sur 2003

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Defcom60

XLDnaute Junior
Bonjour,

j'ai crée un macros sur excel 2003 elle fonctionne bien je voulais l'utilisr sur excel 2007 mais elle ne fonctionne plus voici une partie du code.

Code:
Sub BrowsingForFolder()
Dim SelectedPathFolder As String
Dim concentrateur As String

second1 = second(Time)

    On Error Resume Next
    Workbooks("temp.xls").Close savechanges:=False


     Application.EnableEvents = False
On Error GoTo creation
    Workbooks.Open Filename:=ThisWorkbook.Path & "\temp\temp.xls": On Error GoTo 0: GoTo fin
creation:
     Workbooks.Add
     ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\temp\temp.xls"
fin:
    Application.EnableEvents = True
    On Error Resume Next
    Worksheets("Feuil1").AutoFilterMode = False
    Workbooks("temp.xls").Sheets("Feuil1").Cells().ClearContents
    Workbooks("temp.xls").Sheets("Feuil1").Select

Select Case Tour
Case "B1"
concentrateur = "0008"
Case "TA" To "TB"
    Select Case Etages
    Case 0 To 4
    concentrateur = "0004"
    Case 5 To 9
    concentrateur = "0509"
    Case 10 To 14
    concentrateur = "1014"
    Case 15 To 19
    concentrateur = "1519"
    Case 20 To 24
    concentrateur = "2024"
    Case 25 To 29
    concentrateur = "2529"
    Case 30 To 34
    concentrateur = "3034"
    Case 35 To 39
    concentrateur = "3539"
    End Select

End Select
    concentrateurs = concentrateur
    SelectedPathFolder = Workbooks(ThisWorkbook.Name).Sheets("config").Range("A46").Value & "\" & Tour & concentrateur
    OpeningFiles SelectedPathFolder
    
End Sub

Sub OpeningFiles(SelectedFolder As String)
Dim TxtFile As Variant, mystr As String, Datefichier As String, DateActuelle As String, DateAuto As String, precedentedate As String
Dim heuresauvegarde As String, mystr2 As String, mystr3 As String, heuresauvegarde2 As String
Dim k, l As Integer
Dim mystr4 As String

With Application.FileSearch
   .NewSearch
   .Filename = "*.TXT"
   .LookIn = SelectedFolder
   .Execute
   .SearchSubFolders = False

   
   fichiervide = 1

For Each TxtFile In .FoundFiles
             Datefichier = Right(TxtFile, 17)
             mystr = Mid(Datefichier, 1, 8)
             DateActuelle = Format(Date, "ddmmyyyy")
             precedentedate = Format(precedentdate, "ddmmyyyy")
             
            
If config.CheckBox1.Enabled = True And sauvegardeautomatique = 1 Then
 If Format(Time, "h:mm:ss") > Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("C2").Value, "hh:mm") And Format(Time, "hh:mm:ss") < Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("D2").Value, "hh:mm:ss") Then
   heuresauvegarde = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("C2"), "hhmm")
   heuresauvegarde2 = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("E2"), "hhmm")


   Else
   heuresauvegarde = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("D2"), "hhmm")
   heuresauvegarde2 = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("F2"), "hhmm")
   End If
DateAuto = Right(TxtFile, 17)
mystr = Mid(Datefichier, 1, 13)
mystr2 = Format(Date, "ddmmyyyy") & "_" & heuresauvegarde
mystr3 = Format(Date, "ddmmyyyy") & "_" & heuresauvegarde2
            
If mystr2 = mystr Or mystr3 = mystr Then ImportTXT TxtFile, Dir(TxtFile)
             
End If
        
       
             
If DateActuelle = mystr And testprecendentdate = 0 Then ImportTXT TxtFile, Dir(TxtFile)

If precedentedate = mystr And testprecendentdate = 1 Then ImportTXT TxtFile, Dir(TxtFile)


Next TxtFile
End With


End Sub

la macros s'arrête sans erreur à la ligne With Application.FileSearch
et retour à la procédure precédente sur la ligne end sub.

merci de votre aide.
 
Re : probleme de macro excel 2007 et pas sur 2003

merci pour cette reponse j'ai commencer à modifier le code comme cela

Code:
Sub BrowsingForFolder()
Dim SelectedPathFolder As String
Dim concentrateur As String

second1 = second(Time)

    On Error Resume Next
    Workbooks("temp.xls").Close savechanges:=False


     Application.EnableEvents = False
On Error GoTo creation
    Workbooks.Open Filename:=ThisWorkbook.Path & "\temp\temp.xls": On Error GoTo 0: GoTo fin
creation:
     Workbooks.Add
     ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\temp\temp.xls"
fin:
    Application.EnableEvents = True
    On Error Resume Next
    Worksheets("Feuil1").AutoFilterMode = False
    Workbooks("temp.xls").Sheets("Feuil1").Cells().ClearContents
    Workbooks("temp.xls").Sheets("Feuil1").Select

Select Case Tour
Case "B1"
concentrateur = "0008"
Case "TA" To "TB"
    Select Case Etages
    Case 0 To 4
    concentrateur = "0004"
    Case 5 To 9
    concentrateur = "0509"
    Case 10 To 14
    concentrateur = "1014"
    Case 15 To 19
    concentrateur = "1519"
    Case 20 To 24
    concentrateur = "2024"
    Case 25 To 29
    concentrateur = "2529"
    Case 30 To 34
    concentrateur = "3034"
    Case 35 To 39
    concentrateur = "3539"
    End Select

End Select
    concentrateurs = concentrateur
    SelectedPathFolder = Workbooks(ThisWorkbook.Name).Sheets("config").Range("A46").Value & "\" & Tour & concentrateur
    OpeningFiles SelectedPathFolder
    
End Sub

Sub OpeningFiles(SelectedFolder As String)
Dim TxtFile As Variant, mystr As String, Datefichier As String, DateActuelle As String, DateAuto As String, precedentedate As String
Dim heuresauvegarde As String, mystr2 As String, mystr3 As String, heuresauvegarde2 As String
Dim k, l As Integer
Dim mystr4 As String
Dim Recherche As ClFileSearch.ClasseFileSearch
Dim i As Long
Set Recherche = ClFileSearch.Nouvelle_Recherche
 
With Recherche
    'Définit le répertoire de recherche
    .FolderPath = SelectedFolder
    '.Filename = "*.TXT"
    'Définit la recherche dans les sous dossiers (True / False)
    .SubFolders = False
 
    'Option de tri:
    '(Sort_None, sort_Name, sort_Path, sort_Size, sort_DateCreated, sort_LastModified, sort_Type)
    'Pas de tri si le paramètre n'est pas spécifié.
    .SortBy = sort_Name
 
    'Option pour rechercher un type de fichier
    '(Renvoie tous les fichiers si non spécifié)
    .Extension = "*.txt"
 
    'Execute la recherche
    .Execute
   
   fichiervide = 1
For Each TxtFile In .FoundFiles

             Datefichier = Right(TxtFile, 17)
             mystr = Mid(Datefichier, 1, 8)
             DateActuelle = Format(Date, "ddmmyyyy")
             precedentedate = Format(precedentdate, "ddmmyyyy")
             
            
If config.CheckBox1.Enabled = True And sauvegardeautomatique = 1 Then
 If Format(Time, "h:mm:ss") > Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("C2").Value, "hh:mm") And Format(Time, "hh:mm:ss") < Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("D2").Value, "hh:mm:ss") Then
   heuresauvegarde = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("C2"), "hhmm")
   heuresauvegarde2 = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("E2"), "hhmm")


   Else
   heuresauvegarde = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("D2"), "hhmm")
   heuresauvegarde2 = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("F2"), "hhmm")
   End If
DateAuto = Right(TxtFile, 17)
mystr = Mid(Datefichier, 1, 13)
mystr2 = Format(Date, "ddmmyyyy") & "_" & heuresauvegarde
mystr3 = Format(Date, "ddmmyyyy") & "_" & heuresauvegarde2
            
If mystr2 = mystr Or mystr3 = mystr Then ImportTXT TxtFile, Dir(TxtFile)
             
End If
        
       
             
If DateActuelle = mystr And testprecendentdate = 0 Then ImportTXT TxtFile, Dir(TxtFile)

If precedentedate = mystr And testprecendentdate = 1 Then ImportTXT TxtFile, Dir(TxtFile)

Next TxtFile
End With
Set Recherche = Nothing

End Sub

Sub ImportTXT(TxtFile As Variant, TXTname As String)
Dim Record As String
Dim Container As Variant
Dim i As Double, ii As Byte
Dim derligne As Double


fichiervide = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False


derligne = Range("a65536").End(xlUp).Row
Range("A" & derligne + 1 & "").Select

Open TxtFile For Input As #1
    i = derligne
    Do While Not EOF(1)
        
        i = i + 1
        Line Input #1, Record
        Container = Split(Record, Chr(9)) '9 = "Tab"
            For ii = 1 To 5
                    On Error Resume Next
                    Cells(i, ii) = Application.WorksheetFunction.Substitute(Container(ii - 1), "'", "")
            Next ii
            
    Loop
Close #1




Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

maintenant je coince a cette ligne
For Each TxtFile In .FoundFiles
le .FoundFiles me pause problème car il n'existe plus sur 2007
je ne vois pas comment adapter le code

merci de votre aide.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour