Solved

Download From Web

Posted on 2015-01-04
16
160 Views
Last Modified: 2015-01-06
Hi Expert,

I have one link which leads me to download zip file from server for particular date I need one excel WB in which I put start date and end date & Code it self downloads files from that date rang. please help me out.
 this is the link29 Dec2014.

My Saving directory is "D:\AmiBroker Data\BSE\Eq\"

Thanks
0
Comment
Question by:itjockey
  • 8
  • 7
16 Comments
 
LVL 32

Expert Comment

by:Paul Sauvé
ID: 40530244
what is it exactly you need help with???

The target file in your link is EQ291214_CSV.ZIP.

You can save this file to your pc by clicking on the link, then Save as... and navigate to the folder D:\AmiBroker Data\BSE\Eq\.

Now you have to extract the EQ291214_CSV from the zip file...

Open MS Excel and import the document from the Data tab -> From Text option and navigate to D:\AmiBroker Data\BSE\Eq\ to find the extracted downloaded file, i.e. EQ291214.CSV.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40530357
I can see that this one you have nothing done for it and want to do from scratch ?
Presumen this is Equity BSE ?
gowflow
0
 
LVL 8

Author Comment

by:itjockey
ID: 40530465
Yes Sir.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 29

Expert Comment

by:gowflow
ID: 40530503
ok is this what you want ?

This sub should do the trick

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DownloadFileEquityBSE
' This downloads a file from a URL to a local filename.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function DownloadFileEquityBSE(Overwrite As DownloadFileDisposition) As Boolean
    Dim WSMain As Worksheet
   
    Dim DestinationFileName As String
    Dim Disp As DownloadFileDisposition
    Dim Res As VbMsgBoxResult
    Dim ErrorText As String
    Dim B As Boolean
    Dim S As String
    Dim L As Long
    Dim MaxRowM As Long
    
    'Dim strStartDate As String
    'Dim strEndDate As String
    Dim datLastDate As Date
    Dim datWorkDate As Date
    Dim iYear As Integer
    Dim strMonth As String
    Dim strDay As String
    Dim strFileName As String
    Dim strFilePath As String
    Dim strSavePath As String
    Dim sLastDownloadeddate As String
    Dim oFso As Object

    
    Set WSMain = ActiveSheet

    '---> Clean Previous Trace
    WSMain.Range("A14:I" & WSMain.Rows.Count).ClearContents
    MaxRowM = 14
    
    
    ErrorText = vbNullString

    strSavePath = gstDestinationFolder
    
    If Not bTrace Then
        WSMain.Cells(14, "A").EntireRow.Insert
        WSMain.Cells(14, "A") = "Equity BSE"
        WSMain.Cells(14, "B") = strSavePath
        WSMain.Cells(14, "C") = "*.*"
        WSMain.Cells(14, "F") = "Deleting"
        'MaxRowM = MaxRowM + 1
    End If
    
    '---> Delete All files in Directory prior to proceeding
    DeleteFiles strSavePath
    
    Set oFso = CreateObject("Scripting.FileSystemObject")

    With oFso
        If Not .FolderExists(strSavePath) Then
            MakeMultiStepDirectory strSavePath
        End If
    End With

    
    If dEndDate = vbEmpty Or dStartDate = vbEmpty Then
        MsgBox "Missing either Strat Date or End Date procedure will exit.", vbCritical
        Exit Function
    End If
    
    datLastDate = DateValue(dEndDate)      'DateSerial(iYear, 4, 9)
    datWorkDate = DateValue(dStartDate)    'DateSerial(iYear, 1, 1)
    
    
    Do
        ' EG http://www.bseindia.com/download/BhavCopy/Equity/EQ291214_CSV.ZIP
        strFileName = "EQ" & Format(datWorkDate, "ddmmyy") & "_CSV.ZIP"    ' e.g. EQ291214_CSV.ZIP
        strFilePath = sHTTP & strFileName
        
        If Right(strSavePath, 1) <> "\" Then strSavePath = strSavePath & "\"

        DestinationFileName = strSavePath & strFileName

        If Dir(DestinationFileName, vbNormal) <> vbNullString Then
            Select Case Overwrite
                Case OverwriteKill
                    On Error Resume Next
                    Err.Clear
                    Kill DestinationFileName
                    If Err.Number <> 0 Then
                        ErrorText = "Error Killing file '" & DestinationFileName & "'." & vbCrLf & Err.Description
                        DownloadFileEquityBSE = False
                    End If

                Case OverwriteRecycle
                    On Error Resume Next
                    Err.Clear
                    B = RecycleFileOrFolder(DestinationFileName)
                    If B = False Then
                        ErrorText = "Error Recycleing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                        DownloadFileEquityBSE = False
                        Exit Function
                    End If

                Case DoNotOverwrite
                    DownloadFileEquityBSE = False
                    ErrorText = "File '" & DestinationFileName & "' exists and disposition is set to DoNotOverwrite."
                    Exit Function

                    'Case PromptUser
                Case Else
                    S = "The destination file '" & DestinationFileName & "' already exists." & vbCrLf & _
                        "Do you want to overwrite the existing file?"
                    Res = MsgBox(S, vbYesNo, "Download File")
                    If Res = vbNo Then
                        ErrorText = "User selected not to overwrite existing file."
                        DownloadFileEquityBSE = False
                        Exit Function
                    End If
                    B = RecycleFileOrFolder(DestinationFileName)
                    If B = False Then
                        ErrorText = "Error Recycling file '" & DestinationFileName & "." & vbCrLf & Err.Description
                        DownloadFileEquityBSE = False
                        Exit Function
                    End If
            End Select
        End If
        Debug.Print strFilePath & " validity: " & GetURLStatus(strFilePath)
        If GetURLStatus(strFilePath) = "200 - OK" Then
            L = DeleteUrlCacheEntry(strFilePath)
            L = URLDownloadToFile(0&, strFilePath, DestinationFileName, 0&, 0&)
            Select Case L
                Case Is = 0
                    DownloadFileEquityBSE = True
                    sLastDownloadeddate = datWorkDate
                    
                    '---> Update Trace
                    If Not bTrace Then
                        WSMain.Cells(14, "A").EntireRow.Insert
                        WSMain.Cells(14, "A") = "Equity BSE"
                        WSMain.Cells(14, "B") = strSavePath
                        WSMain.Cells(14, "C") = strFileName
                        WSMain.Cells(14, "F") = "Created"
                        'MaxRowM = MaxRowM + 1
                    End If
                Case Is = -2146697210
                    ErrorText = "File not found."
                    DownloadFileEquityBSE = False
                Case Is = -2146697211
                    ErrorText = "Domain not found."
                    DownloadFileEquityBSE = False
                Case Is = -2147467260
                    ErrorText = "Transfer aborted."
                    DownloadFileEquityBSE = False
                Case Else
                    ErrorText = "Buffer length invalid or not enough memory."
                    DownloadFileEquityBSE = False
            End Select
        End If
        datWorkDate = DateAdd("d", 1, datWorkDate)
    Loop Until datWorkDate > datLastDate

'---> Set New Start Date = last successful date + Clear End Date
If sLastDownloadeddate <> "" Then
    Range("E8").Value = DateAdd("d", 1, sLastDownloadeddate)
    Range("F8").Formula = "=Today()"
    'MsgBox "Last Successful downloaded file was on " & sLastDownloadeddate & Chr(10) & "The next set date for next run of the routine will be set at " & Range("G3").Value
Else
    Range("F8").Formula = "=Today()"
    'MsgBox "No Files where found in this Interval try later."
End If

End Function

Open in new window


gowflow
0
 
LVL 8

Author Comment

by:itjockey
ID: 40530913
Sir.Gowflow,

I had attached above code to new WB & created button but I cant see macro while I am assigning to that button.

See attached



Thanks
BSEeq-V01.xlsm
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40531105
ok sorry forgot to give you steps to implement in your production workbook.

1) Make a copy of your last production workbook the new one that comprises all options and give it a new name.
2) Goto VBA ALT F11
3) Create a new Module and from the View Menu select Property Window
4) click on the new Module created it should be Module1 change its name to aStartEquityBSE
5) doubleclick on this new module and paste the code I posted in my last comment in this new module.
6) Save the workbook.
7) We need now to add the call to this procedure. doubleclick on the sheet Main in the left pane
8) Display the code for CommandButton6
9) Delete all the code that is between CommandButton6 and End Sub.
10) Paste the below in there just after CommandButton6_click

bTrace = CheckBox21.Value
bAudit = CheckBox22.Value
gstDestinationFolder = Range("B8")
If bTesting Then gstDestinationFolder = ActiveWorkbook.Path & "\Temp\"
dStartDate = Range("E8")
dEndDate = Range("F8")
sHTTP = Sheets("Settings").Range("B7")

'---> Start Download
DownloadFileEquityBSE (OverwriteRecycle)

MsgBox ("Equity BSE Done")

Open in new window


11) You will also need to replace a Sub. goto VBA doubleclick on the Module aStartDelivery locate the Sub DeleteFiles and delete it from the first line till End Sub.
12) Paste the below new Sub after any End Sub in this module.

Sub DeleteFiles(sStrPath As String)
If sStrPath = "" Or sStrPath <> gstDestinationFolder Then
    MsgBox "Warning !!!! file path to delete is: [" & sStrPath & "] Files will not be deleted from this location.", vbCritical
    Exit Sub
Else
    On Error Resume Next
    Kill sStrPath & "*.csv"
    Kill sStrPath & "*.zip"
    On Error GoTo 0
End If

End Sub

Open in new window

13) Save and Exit the workbook.
14) open this new version and try the Equity BSE.

Let me know.
gowflow
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40531809
Did you try to incorporate the code ?
gowflow
0
 
LVL 8

Author Comment

by:itjockey
ID: 40532006
yes I did it Sir...sorry for delay.ErrorSee attached.

Thanks
Incoporated-Download-File-V02.xlsm
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40532507
Try this. Didn't want to attach your full file felt you wanted to protect your achievement. Recommend for the future to proceed like this one. When you get an error you specify what is the error and what line.
gowflow
Incoporated-Download-File-V02.xlsm
0
 
LVL 8

Author Comment

by:itjockey
ID: 40532798
This time no error but what mi looking for not done.Done messageBut in actual directory there is nothing.Thanks
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
ID: 40533071
ok here it is.
jus needed to remove the file name from the link in settings.
gowflow
Incoporated-Download-File-V02.xlsm
0
 
LVL 8

Author Comment

by:itjockey
ID: 40533086
I will revert you back as soon as possible ...right now out of the desk.

Thank you Sir.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40533188
ok
0
 
LVL 8

Author Closing Comment

by:itjockey
ID: 40533581
Perfect - May I ask follow up? it is downloading Zip files need to add zip procedure.

Thanks
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40534112
yes pls go ahead
gowflow
0
 
LVL 8

Author Comment

by:itjockey
ID: 40534861
here it is.

Thanks
0

Featured Post

Secure Your Active Directory - April 20, 2017

Active Directory plays a critical role in your company’s IT infrastructure and keeping it secure in today’s hacker-infested world is a must.
Microsoft published 300+ pages of guidance, but who has the time, money, and resources to implement? Register now to find an easier way.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

713 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question