Solved

Downloader 2

Posted on 2014-01-05
20
315 Views
Last Modified: 2014-01-06
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
0
Comment
Question by:itjockey
  • 11
  • 9
20 Comments
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
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

0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
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
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
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
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
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
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Sorry. Just click the button.
Test.xlsm
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
Mr.MacroShadow,

I got this Error message...
Message
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
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 ...
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
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
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Sorry my bad.
Test.xlsm
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
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
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
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
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
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
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
I don't understand. How many files is it supposed to download?
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
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
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Sorry my bad. Try this.
Test.xlsm
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
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
0
 
LVL 26

Accepted Solution

by:
MacroShadow earned 500 total points
Comment Utility
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

0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
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
0
 
LVL 8

Author Closing Comment

by:itjockey
Comment Utility
Thank You Very Much.........Now I can do same amount work in 1 hour instead of 10  :)
0
 
LVL 8

Author Comment

by:itjockey
Comment Utility
Sir.MacroShadow,

this is the link Downloader 3


Thank You
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Outlook Free & Paid Tools
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

771 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now