Comment afficher page vide si fichier introuvable

Résolu/Fermé
hakoko Messages postés 187 Date d'inscription lundi 11 mars 2013 Statut Membre Dernière intervention 21 mars 2024 - 8 juil. 2013 à 11:19
hakoko Messages postés 187 Date d'inscription lundi 11 mars 2013 Statut Membre Dernière intervention 21 mars 2024 - 11 juil. 2013 à 20:29
bonjour à tous,

je travaille avec la macro ci-dessous qui importe cinq(5) fichiers,chaque partie de la macro s'occupe d'un fichier,elle le retrouve par son chemin .

Le probleme qui se pose c'est qu'elle bug si elle ne trouve pas un de ces 5 fichiers ;tandis que je voudrais qu'elle affiche une page vide dans le cas ou le fichier est introuvable,puis passer au fichier suivant.

Merci d'avance pour ceux qui voudrons m'aider.

----------------------------------------------------------
Type Enregistrement

Date As String * 10
Time As String * 8
Temp_Out As String * 7
Hi_Temp As String * 7
Low_Temp As String * 6
Out_Hum As String * 7
Dew_Pt As String * 6
Wind_Speed As String * 6
Wind_Dir As String * 7
Wind_run As String * 6
Hi_Speed As String * 7
Hi_Dir As String * 5
Wind_Chill As String * 7
Heat_Index As String * 7
THW_Index As String * 7
Bar As String * 8
Rain As String * 6
Rain_Rate As String * 7
Heat_D_D As String * 8
Cool_D_D As String * 8
In_Temp As String * 6
In_Hum As String * 7
In_Dew As String * 7
In_Heat As String * 7
In_EMC As String * 6
In_Air_Density As String * 8
Wind_Samp As String * 6
Wind_Tx As String * 6
ISS_Recept As String * 8
Arc_Int As String * 6

End Type







Sub DerLigne()




Dim Rep As String
Dim REQ As QueryTable
Dim Fe As Worksheet
Dim Plage As Range
Dim Fichier As String

Rep = "C:\Users\GREEN.215AINFO00.000\Downloads\"
Fichier = Dir(Rep & "*.CSV")

'Fichier = "C:\Users\GREEN.215AINFO00.000\Downloads\download.CSV"
With Worksheets("Feuil1")
Set REQ = .QueryTables.Add("TEXT;" & Rep & Fichier, .Range("A2"))

With REQ

.Name = Fichier
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Set Plage = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp).Offset(-1, 0))

Plage.EntireRow.Delete

End With












Dim Enrg As Enregistrement
'Dim I As Long
Dim Der As Long

Fichier = "\\193.50.118.63\WeatherLink\IUTMP\download.txt"


Open Fichier For Random As #1 Len = Len(Enrg)

'calcule le nombre d'enreristrement...
Der = LOF(1) / Len(Enrg)

'et récupère le dernier
Get #1, Der, Enrg

Close #1

'et les inscrits dans la ligne 1
With Enrg

Range("A3") = .Date
Range("A3").Offset(0, 1) = .Time
Range("A3").Offset(0, 2) = .Temp_Out
Range("A3").Offset(0, 3) = .Hi_Temp
Range("A3").Offset(0, 4) = .Low_Temp
Range("A3").Offset(0, 5) = .Out_Hum
Range("A3").Offset(0, 6) = .Dew_Pt
Range("A3").Offset(0, 7) = .Wind_Speed
Range("A3").Offset(0, 8) = .Wind_Dir
Range("A3").Offset(0, 9) = .Wind_run
Range("A3").Offset(0, 10) = .Hi_Speed
Range("A3").Offset(0, 11) = .Hi_Dir
Range("A3").Offset(0, 12) = .Wind_Chill
Range("A3").Offset(0, 13) = .Heat_Index
Range("A3").Offset(0, 14) = .THW_Index
Range("A3").Offset(0, 15) = .Bar
Range("A3").Offset(0, 16) = .Rain
Range("A3").Offset(0, 17) = .Rain_Rate
Range("A3").Offset(0, 18) = .Heat_D_D
Range("A3").Offset(0, 19) = .Cool_D_D
Range("A3").Offset(0, 20) = .In_Temp
Range("A3").Offset(0, 21) = .In_Hum
Range("A3").Offset(0, 22) = .In_Dew
Range("A3").Offset(0, 23) = .In_Heat
Range("A3").Offset(0, 24) = .In_EMC
Range("A3").Offset(0, 25) = .In_Air_Density
Range("A3").Offset(0, 26) = .Wind_Samp
Range("A3").Offset(0, 27) = .Wind_Tx
Range("A3").Offset(0, 28) = .ISS_Recept
Range("A3").Offset(0, 29) = .Arc_Int

End With







Dim Tbl() As String
Dim Ligne As String
Dim I As Integer
Dim txt As String
'adapter le chemin et nom du fichier
txt = ""

' il faut calculer en fonction de la date
Fichier = "a" & Format(Date, "yyyymmdd") & ".TXT"
chemin = "\\193.50.118.63\data\"
'If Fichier <> "" Then
'End If
'Open "\\193.50.118.63\data\a20130612.txt" For Input As #1
Open chemin & Fichier For Input As #1
Do While Not EOF(1)

Line Input #1, Ligne

txt = txt & Ligne & vbCrLf

Loop

Close #1

'résultat dans la fenêtre d'exécution (Ctrl+G)
' Debug.Print Tbl(I)
Tbl = Split(txt, vbCrLf)
For I = UBound(Tbl) To 0 Step -1
If Trim("" & Tbl(I)) <> "" Then
Tbl = Split(Tbl(I), Chr(9))
Range(Cells(4, 1), Cells(4, UBound(Tbl))) = Tbl()
Exit For
End If
Next











Dim CH, CH2 As String


CH = "C:\Users\GREEN.215AINFO00.000\Desktop\graphtec820\CH.TXT"


With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & CH, Destination:= _
Range("$A$5"))
.Name = Fichier
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.Delete
End With









CH2 = "C:\Users\GREEN.215AINFO00.000\Desktop\graphtec800\CH.TXT"


With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & CH2, Destination:= _
Range("$D$5"))
.Name = Fichier
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.Delete
End With



'positionne sur cellule A1
Range("A1").Select
'Parametrage interval temps import: ici 3 secondes
Next_Scan = Now() + TimeValue("00:04:00")
Application.OnTime Next_Scan, "Derligne"

Application.ScreenUpdating = True

End Sub
A voir également:

2 réponses

melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
9 juil. 2013 à 10:30
coucou,

essaie ca :

au debut de ton code au lieu d'écrire :

Rep = "C:\Users\GREEN.215AINFO00.000\Downloads\"
Fichier = Dir(Rep & "*.CSV")

With Worksheets("Feuil1")
Set REQ = .QueryTables.Add("TEXT;" & Rep & Fichier, .Range("A2"))



écris :

Rep = "C:\Users\GREEN.215AINFO00.000\Downloads\"
Fichier = Dir(Rep & "*.CSV")
if err<> 0 then
With Worksheets("Feuil1")
Set REQ = .QueryTables.Add("TEXT;" & Rep & Fichier, .Range("A2"))


'tu écris tout ton code et tu mets end if juste avant de changer de fichier
1
hakoko Messages postés 187 Date d'inscription lundi 11 mars 2013 Statut Membre Dernière intervention 21 mars 2024 3
9 juil. 2013 à 14:43
merci bcp, magnifique ça marche!!
0
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
11 juil. 2013 à 11:18
Mets ton pb en résolu stp.
0
hakoko Messages postés 187 Date d'inscription lundi 11 mars 2013 Statut Membre Dernière intervention 21 mars 2024 3
11 juil. 2013 à 20:29
ok , sans faute :)
0