PDA

View Full Version : [SOLVED:] Retrieve data by downloading a text file from a site



FrancisZheng
02-27-2017, 07:43 AM
Hi everyone,

I was given a function that allows users to download a text file. I wrote the gop sub. But I don't know how to call this function. I tried
Set oWsBDR = WbBDR.Worksheets() But there's an error.

Thank you in advance.



Sub gop()
Dim oWsBDR As Excel.Worksheet

On Error Resume Next

Set oWsBDR = WbBDR.Worksheets(CS_SHEET)

Worksheets("downloadFile").Cells.Copy
Workbooks("Task2").Sheets("Data").Paste
Application.CutCopyMode = False
Workbooks("Task2").Worksheets("Data") = "OPERATING GROUP MNEMONIC"
With Worksheets("Data").Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.ColumnWidth = 30
End With
Set oWsBDR = Nothing
Application.DisplayAlerts = False
Windows("downloadFile.ln").Activate
ActiveWindow.Close
End Sub
Public Function WbBDR() As Excel.Workbook
Dim bOk As Boolean
Dim m_oME As Excel.Workbook
Dim m_oBDR As Excel.Workbook

If m_oBDR Is Nothing Then
bOk = False
Err.Clear
On Error Resume Next
Do Until bOk
Workbooks.OpenText Filename:="https://.../downloadFile.ln?fileName=...", _
Origin:=xlMSDOS, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), _
Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), _
Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), _
Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array(36, 1), _
Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1), _
Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), _
Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), _
Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1)), _
TrailingMinusNumbers:=True
If Err.Number = 0 Then bOk = True
Err.Clear
Loop
On Error GoTo 0
Set m_oBDR = Application.Workbooks("downloadFile.ln")
'Set m_oBDR = Application.Workbooks("Task2")
End If
Set WbBDR = m_oBDR
End Function

FrancisZheng
02-27-2017, 07:58 AM
I Wonder if I could copy the data directly into the sheet"Data"...

FrancisZheng
03-03-2017, 03:46 AM
Solution found !


Sub Run()
Dim oWsBDR As Excel.Workbook

'On Error Resume Next

Set oWsBDR = WbBDR()
If oWsBDR Is Nothing Then
MsgBox "Le fichier n'a pas été extrait."
Else
oWsBDR.Worksheets("downloadFile").UsedRange.Copy
Workbooks("Task2.xlsm").Worksheets("Data").Cells(1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
With Workbooks("Task2").Worksheets("Data").Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.ColumnWidth = 30
End With


Workbooks("Task2.xlsm").Worksheets("Data").AutoFilter.Sort.SortFields.Clear
Workbooks("Task2.xlsm").Worksheets("Data").AutoFilter.Sort.SortFields.Add Key:=Range("H1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
With Workbooks("Task2.xlsm").Worksheets("Data").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


Set oWsBDR = Nothing
End If
Application.DisplayAlerts = False
Windows("downloadFile.ln").Close


Dim lastRow, z As Integer
Dim countYear(1 To 27) As Integer
Dim countMonth(1 To 12) As Integer
With Worksheets("Data")
lastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With

For z = 1 To 27
countYear(z) = 0
Next z
For z = 1 To 12
countMonth(z) = 0
Next z

With Worksheets("Data")
For z = 2 To lastRow
Select Case Year(.Cells(z, 8))
Case 2017
countMonth(Month(.Cells(z, 8))) = countMonth(Month(.Cells(z, 8))) + 1
Case Else
If Year(.Cells(z, 8)) > 1990 And Year(.Cells(z, 8)) < 2017 Then
countYear(Year(.Cells(z, 8)) - 1989) = countYear(Year(.Cells(z, 8)) - 1989) + 1
End If
End Select
Next z
End With

With Worksheets("Statistics")
For z = 28 To 2 Step -1
.Cells(z, 2) = countYear(29 - z)
Next z
For z = 4 To 15
.Cells(2, z) = countMonth(z - 3)
Next z
End With

Workbooks("Task2.xlsm").Worksheets("Page Accueil").Activate

End Sub

FrancisZheng
03-03-2017, 09:00 AM
Thank you.

FrancisZheng
03-08-2017, 06:29 AM
1857218573