troubleshooting Question

Downloader 2

Avatar of Naresh Patel
Naresh PatelFlag for India asked on
Microsoft OfficeMicrosoft ExcelMicrosoft Applications
20 Comments1 Solution496 ViewsLast Modified:
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


See Attached File.

Thanks
Test.xlsm
ASKER CERTIFIED SOLUTION
Joe Howard

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 20 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 20 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros