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
|
Private Function lancementimport(groupe As String) As Integer
Dim i, j As Integer
Dim httpobj As New WinHttpRequest
Dim Fso As New FileSystemObject 'reference microsoft file scripting reference'
Dim TxtStream As TextStream
Dim ligne, httpreq As String
Const timeout As Long = 600000
Dim intSslErrorIgnoreFlag
Dim objStream As Variant
Const OutputFilePath As String = "p:\casesItrack.txt"
Const ReqHeader As String = "https://tool.int/extract_NEW.php?"
intSslErrorIgnoreFlag = 13056
With httpobj
httpreq = ReqHeader _
& "DTStart=" & Sheets("parametres").Range("datedebut").Text _
& "&DTEnd=" & Sheets("parametres").Range("datefin").Text _
& "&Group=" & groupe & "&Analyst=" & "" ' construction de la requete HTTP'
.Open "GET", httpreq 'preparation entete'
.SetTimeouts timeout, timeout, timeout, timeout 'setting des timeout'
Application.StatusBar = "Requête transmise groupe " & groupe & ". Attente de réponse ..."
.Option(4) = intSslErrorIgnoreFlag
.Send 'execution'
End With
Set objStream = CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 2 'adTypeText'
objStream.Charset = "ISO-8859-15"
objStream.WriteText httpobj.ResponseText
objStream.SaveToFile OutputFilePath, 2 'adSaveCreateOverWrite'
objStream.Close
Application.StatusBar = "Parsing des lignes... " & groupe
i = 1
Set TxtStream = Fso.OpenTextFile(OutputFilePath, ForReading)
If Not TxtStream.AtEndOfStream Then ligne = TxtStream.ReadLine
While Not TxtStream.AtEndOfStream
ligne = TxtStream.ReadLine
ligne = Replace(ligne, "", " ")
Sheets("casesitrack").Range(("A") & CStr(lignedepart + i - 1)).Value = ligne
Application.StatusBar = "Parsing des lignes " & CStr(i)
i = i + 1
Wend
TxtStream.Close
' split du case sur la ligne'
For j = 1 To i - 1
Application.StatusBar = "Copie ... Ligne " & groupe & i
Sheets("casesitrack").Range("A" & CStr(lignedepart + j - 1)).TextToColumns _
Destination:=Sheets("casesitrack").Range("B" & CStr(lignedepart + j - 1)), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, _
Space:=False, Other:=False, TrailingMinusNumbers:=True
Next
lancementimport = i |
Partager