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 n'importe rien si elle ne le trouve pas ,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
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 n'importe rien si elle ne le trouve pas ,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
