Discussion :

[froggyaz]

Bonjour a tous,

Je travaille sous excel 2007 et je voudrais importer des donnes externes a partir d'un fichier text. J'ai le code suivant qui fonctionne correctement avec le premier fichier. l'obtention se fait grace a une boucle de type "for file 10 to 30". Je sais que certains des fichiers n'existent plus, d'ou la ligne "on error resume", cependant les fichiers qui existent ne sont pas extrait.

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 14/01/2009 by Administrator
'
 
Sheets("Sheet2").Select
Dim month As Integer
Dim day As Integer
Dim file As Integer
Dim cellnumber As Integer
Dim folders As String
 
month = InputBox("Which month do you want to get?" & vbCrLf & "(1 for January,..., 12 for December)")
day = InputBox("Which day do you want to get?" & vbCrLf & "(1, 2,...,31)", "   ")
cellnumber = 3
Application.ScreenUpdating = False
On Error Resume Next
    Select Case month
        Case 1
            Worksheets("Sheet2").Range("D1").Value = "Jan"
        Case 2
            Worksheets("Sheet2").Range("D1").Value = "Feb"
        Case 3
            Worksheets("Sheet2").Range("D1").Value = "Mar"
        Case 4
            Worksheets("Sheet2").Range("D1").Value = "Apr"
        Case 5
            Worksheets("Sheet2").Range("D1").Value = "May"
        Case 6
            Worksheets("Sheet2").Range("D1").Value = "Jun"
        Case 7
            Worksheets("Sheet2").Range("D1").Value = "Jul"
        Case 8
            Worksheets("Sheet2").Range("D1").Value = "Aug"
        Case 9
            Worksheets("Sheet2").Range("D1").Value = "Sep"
        Case 10
            Worksheets("Sheet2").Range("D1").Value = "Oct"
        Case 11
            Worksheets("Sheet2").Range("D1").Value = "Nov"
        Case 12
            Worksheets("Sheet2").Range("D1").Value = "Dec"
    End Select
            For file = 10 To 30
             On Error Resume Next
                Worksheets("Sheet2").Range("E1").Value = day
                Worksheets("Sheet2").Range("F1").Value = file
                Worksheets("Sheet1").Range("B" & cellnumber).Value = Worksheets("Sheet2").Range("B1").Value
                folders = Worksheets("Sheet2").Range("B1").Value
                Worksheets("Sheet1").Select
                Worksheets("Sheet1").Range("A" & cellnumber).Select
 
                With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & folders, Destination:=ActiveCell)
                    .Name = "title."
                    .FieldNames = False
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .RefreshStyle = xlInsertDeleteCells
                    .SavePassword = False
                    .SaveData = False
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .TextFilePromptOnRefresh = False
                    .TextFilePlatform = 850
                    .TextFileStartRow = 1
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote
                    .TextFileConsecutiveDelimiter = False
                    .TextFileTabDelimiter = True
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = False
                    .TextFileColumnDataTypes = Array(2)
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
 
                End With
 
 
                Worksheets("Sheet1").Range("A" & cellnumber).Select
                If ActiveCell.Value <> "" Then
                cellnumber = cellnumber + 2
                Else
                EntireRow.Delete
                EntireRow.Delete
                MsgBox (file)
                End If
            Next file
Application.ScreenUpdating = True
 
End Sub

Le code fonctionnait tres bien avec ma version precedente d'excel.
Merci d'avance pour votre aide.

Fred

[neupont]

Bonjour,
il faudrait justement enlever le "on error resume next" pour voir à quelle(s) ligne(s) ça plante.

[froggyaz]

Merci Neupont,
Je viens de retirer le "on error resume": Malheureusement, le programme me donne toujours le meme resultat, a savoir qu'il copie bien les chemins (paths!) comme convenu mais n'extrait toujours pas le text associe a ces chemins, sauf pour le premier. Et il y a toujours le meme message d'erreur apres la deuxieme boucle:

J:\blah\blah blah\11\pdata\1\title’ cannot be found. Check your spelling, or try a different path.

Fred

[froggyaz]

J'ai resolu mon probleme en enlevant le "on error" et en ajoutant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
For file = 10 To 30
if len(dir(folders)) > 0 then
'mon code
end if
next

Bon week-end a tous.
Fred