Downloader 2

Hi Experts,

Need little code Modification in this -
while I start it asking for save on location & have to click "save" Button. Want to over come on this . i.e. it will done by auto without click. if save location hard coded in VBA most preferable.

have to change year in code to download data for particular year. so I cant download with 2 years.

Option Explicit
' Expected sequence: BeforeNavigate, DownloadBegin, NavigateComplete2, DownloadComplete, DocumentComplete
Private mbFileDownloading As Boolean
Private mstrDocumentToWaitFor As String
Private mbErrorFound As Boolean

Private Sub UserForm_Activate()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Const navOpenInBackgroundTab As Long = &H1000
    DoEvents
    LoadAllFiles
End Sub

Private Sub LoadAllFiles()
    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 lSanityCheck As Long
    
    Const navOpenInBackgroundTab As Long = &H1000
    Const lDelayTime As Long = 500000
    
    strStartDate = Range("A1").Value 'Range("StartDate").Value
    strEndDate = Range("B1").Value 'Range("EndDate").Value
    
    iYear = 2014
    
    datLastDate = DateValue(strEndDate) ' 'DateSerial(iYear, 4, 9)
    datWorkDate = DateValue(strStartDate) 'DateSerial(iYear, 1, 1)
    Do
        mbFileDownloading = False
        mbErrorFound = False
        
        strMonth = UCase(Format(datWorkDate, "MMM")) ' upper case name of the month, like JAN
        strFileName = "cm" & Right("0" & Day(datWorkDate), 2) & strMonth & iYear & "bhav.csv.zip" ' e.g. cm01JAN2013bhav.csv.zip
        strFilePath = "http://nseindia.com/content/historical/EQUITIES/" & iYear & "/" & strMonth & "/" & strFileName
        mstrDocumentToWaitFor = strFilePath
        Debug.Print strFilePath
        WebBrowser1.Navigate2 strFilePath, navOpenInBackgroundTab
        
        lSanityCheck = 0
        While WebBrowser1.Busy
            DoEvents
            lSanityCheck = lSanityCheck + 1
            If lSanityCheck > lDelayTime Then
                Debug.Print "Out of time"
                Exit Do
            End If
        Wend
        Do Until mbFileDownloading
            DoEvents
            lSanityCheck = lSanityCheck + 1
            If lSanityCheck > lDelayTime Then
                Debug.Print "Out of time"
                Exit Do
            End If
        Loop
        
        If mbErrorFound Then
            Debug.Print "File " & datWorkDate & " not found"
        Else
            'MsgBox "Ready for next file--click [OK]"
        End If
        datWorkDate = DateAdd("d", 1, datWorkDate)
        Debug.Print
    Loop Until datWorkDate > datLastDate
    Debug.Print "Process complete."
End Sub

Private Sub WebBrowser1_FileDownload(ByVal ActiveDocument As Boolean, Cancel As Boolean)
    Debug.Print "WebBrowser1_FileDownload "; ActiveDocument
    mbFileDownloading = True
End Sub

Private Sub WebBrowser1_NavigateError(ByVal pDisp As Object, URL As Variant, Frame As Variant, StatusCode As Variant, Cancel As Boolean)
    Debug.Print "WebBrowser1_NavigateError "; URL & " type: " & TypeName(pDisp) & " StatusCode " & StatusCode
    mbFileDownloading = True
    mbErrorFound = True
End Sub
'
'Private Sub WebBrowser1_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)
'    'Debug.Print "WebBrowser1_CommandStateChange " & Command
'End Sub
'
'Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
'    Debug.Print "WebBrowser1_ProgressChange "; Progress
'    miProgressLevel = Progress
'End Sub

Open in new window



See Attached File.

Thanks
Test.xlsm
LVL 8
Naresh PatelFinancial AdviserAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Joe HowardCommented:
If all you need is to download a file, using a WebBrowser control is an unnecessary overkill.
This will work to download a file using Windows Api calls (will work on both 32-bit and 64-bit):
Option Explicit


Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile _
            Lib "urlmon" Alias "URLDownloadToFileA" _
            (ByVal pCaller As Long, _
             ByVal szURL As String, _
             ByVal szFileName As String, _
             ByVal dwReserved As Long, _
             ByVal lpfnCB As Long) As Long
#Else
    Private Declare Function URLDownloadToFile _
                          Lib "urlmon" Alias "URLDownloadToFileA" _
                              (ByVal pCaller As Long, _
                               ByVal szURL As String, _
                               ByVal szFileName As String, _
                               ByVal dwReserved As Long, _
                               ByVal lpfnCB As Long) As Long
#End If

Sub Demo()

    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

    strStartDate = Range("A1").Value    'Range("StartDate").Value
    strEndDate = Range("B1").Value    'Range("EndDate").Value
    strSavePath = "C:\Test\"    ' Or Range("C1").Value

    iYear = 2014

    datLastDate = DateValue(strEndDate)    ' 'DateSerial(iYear, 4, 9)
    datWorkDate = DateValue(strStartDate)    'DateSerial(iYear, 1, 1)

    strMonth = UCase(Format(datWorkDate, "MMM"))    ' upper case name of the month, like JAN
    strFileName = "cm" & Right("0" & Day(datWorkDate), 2) & strMonth & iYear & "bhav.csv.zip"    ' e.g. cm01JAN2013bhav.csv.zip
    strFilePath = "http://nseindia.com/content/historical/EQUITIES/" & iYear & "/" & strMonth & "/" & strFileName

    Call DownloadFileFromWeb(strFilePath, strSavePath)

End Sub

Public Function DownloadFileFromWeb(strUrl As String, strSavePath As String) As Long
    On Error GoTo err_1

    ' Returns 0 if success, error code if not.
    ' Error codes:
    ' -2146697210 "file not found".
    ' -2146697211 "domain not found".
    ' -2147467260 "transfer aborted".

    DownloadFileFromWeb = URLDownloadToFile(0, strUrl, strSavePath, 0, 0)

Err_Exit:
    Exit Function

err_1:
    MsgBox Err.Description
    Resume

End Function

Open in new window

Joe HowardCommented:
You may find this of interest:
AFAIK, you can't save page from WebBrowser control without showing the dialog.

1. You can subclass your form and when the savedialog appears, you can hide the dialog, programmetically put the path and hit the save button. (I wrote similar code for common dialog a few days ago. Search the forum.)

2. Or, BETTER, you can loop through all objects in the DOM (WebBrowser1.Documnt) and save then from cache (or re-download those objects using URLDownloadToFile API - this will use cache by default).
(see the WebBrowser related posts in the "usefull threads..." link in my sig for an example for images.)
Source
Naresh PatelFinancial AdviserAuthor Commented:
Mr.MacroShadow,

What You Want Me To do?
Copy past your code on my existing file or copy past in new one & try it?


Thanks
Get Blueprints for Increased Customer Retention

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

Naresh PatelFinancial AdviserAuthor Commented:
Mr.MacroShodow,

I am beginner to coding I don't understand very much, Even this code also provided by one of the expert in past question.so will you pls attached workbook instead & pls tell me what to do?



Thanks
Joe HowardCommented:
Sorry. Just click the button.
Test.xlsm
Naresh PatelFinancial AdviserAuthor Commented:
Mr.MacroShadow,

I got this Error message...
Message
Joe HowardCommented:
I don't know, it should work, and has indeed in the past.

Maybe you should post a new question asking why it doesn't work ...
Naresh PatelFinancial AdviserAuthor Commented:
Mr.MacroShadow,

Overcome from above message but still confusion. Pop up this message Message Pop UpBut there is no data or file in  "C:\Test\"


Thanks
Joe HowardCommented:
Sorry my bad.
Test.xlsm
Naresh PatelFinancial AdviserAuthor Commented:
Mr.MacroShodow,
I can't check right now. As netdown in my location.Replying from my mobile.i will get back to as soon as possible.

Thank You
Joe HowardCommented:
Or you can use this greatly enhanced version, which incorporates some of the many works shared by Excel MasterMind Chip Pearson, chip@cpearson.com, www.cpearson.com.

List of enhancements:

Create destination folder if it doesn't exist (will create nested directories too, i.e. C:\Test\Test\Test\Test)
Gives four options what to do if file exists at destination (Overwrite, Recycle, Ignore, PromptUser)
Verifies that file exists on server before attempting download
Test.xlsm
Naresh PatelFinancial AdviserAuthor Commented:
Mr.MacroShadow,

Enhanced Solution is working but it download only one file i.e. from start date very 1st or latest available. After that it stopped.



Thanks
Joe HowardCommented:
I don't understand. How many files is it supposed to download?
Naresh PatelFinancial AdviserAuthor Commented:
Mr.MacroShadow,

See it is date range so say if I put start date as 1 Jan 2014 to End Date 7 Jan 2014 then it will download all files in this date range & whichever is available. if any file is not available for particular date then go for next.



Thanks
Joe HowardCommented:
Sorry my bad. Try this.
Test.xlsm
Naresh PatelFinancial AdviserAuthor Commented:
Sir.MacroShadow,

All Done - last request if it is possible.
Click For DownloadClick For OverPastDo we overcome with this clicks. default value = "Ok" & "Yes".


Thanks
Joe HowardCommented:
Remove this line:
MsgBox Right(strFilePath, InStr(1, StrReverse(strFilePath), "/") - 1) & " successfully downloaded to " & strSavePath

Open in new window


And change:
Call DownloadFile(PromptUser)

Open in new window

To this (if you want existing file deleted):
Call DownloadFile(OverwriteKill)

Open in new window

Or to this (if you want existing file sent to the recycle bin):
Call DownloadFile(OverwriteRecycle)

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Naresh PatelFinancial AdviserAuthor Commented:
Sir.MacroShadow,

Will you pls look in to my next questions same as this just download link is different. (If you feel to).

With in a 5 min posting link here.


Thanks
Naresh PatelFinancial AdviserAuthor Commented:
Thank You Very Much.........Now I can do same amount work in 1 hour instead of 10  :)
Naresh PatelFinancial AdviserAuthor Commented:
Sir.MacroShadow,

this is the link Downloader 3


Thank You
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.