Solved

Downloader 2

Posted on 2014-01-05
20
324 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:Naresh Patel
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 11
  • 9
20 Comments
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39758582
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 27

Expert Comment

by:MacroShadow
ID: 39758591
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:Naresh Patel
ID: 39758593
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
Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 
LVL 8

Author Comment

by:Naresh Patel
ID: 39758596
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 27

Expert Comment

by:MacroShadow
ID: 39758614
Sorry. Just click the button.
Test.xlsm
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39758631
Mr.MacroShadow,

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

Expert Comment

by:MacroShadow
ID: 39758649
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:Naresh Patel
ID: 39758691
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 27

Expert Comment

by:MacroShadow
ID: 39759086
Sorry my bad.
Test.xlsm
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39759195
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
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39759259
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:Naresh Patel
ID: 39761163
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 27

Expert Comment

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

Author Comment

by:Naresh Patel
ID: 39761223
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 27

Expert Comment

by:MacroShadow
ID: 39761323
Sorry my bad. Try this.
Test.xlsm
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39761345
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 27

Accepted Solution

by:
MacroShadow earned 500 total points
ID: 39761365
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:Naresh Patel
ID: 39761367
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:Naresh Patel
ID: 39761395
Thank You Very Much.........Now I can do same amount work in 1 hour instead of 10  :)
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39761417
Sir.MacroShadow,

this is the link Downloader 3


Thank You
0

Featured Post

Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

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 …
Ever wonder what it's like to get hit by ransomware? "Tom" gives you all the dirty details first-hand – and conveys the hard lessons his company learned in the aftermath.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
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…

623 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