Option Explicit
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
Public WB As Workbook
Public WS As Worksheet
Public i As Long
Public sErr As String
Public Const NL As String = vbNewLine
Public Const DNL As String = vbNewLine & vbNewLine
Sub LaunchUserform()
Load ufGetData
ufGetData.Show
End Sub
Sub UnzipFile(dtLook As Date)
'Set CLEANUP to True to delete zip file after extraction
'Leave as False to not delete zip file after extraction
Const CLEANUP As Boolean = True
'Variable declaration
Dim oApp As Object
Dim vFile As Variant
Dim sFileName As Variant
Dim aName As Variant
Dim vFolderName As Variant
Dim vSaveFileName As Variant
Dim sDay As String
Dim sMonth As String
Dim sYear As String
Dim sDate As String
Dim sExtractFileName As String
Dim ret As Long
Dim iMonth As Long
Dim aURLs(1 To 5, 1 To 4) As Variant
'Set file name variables
sDay = CStr(Format(Day(dtLook), "00"))
sMonth = UCase(CStr(MonthName(Month(dtLook), True)))
iMonth = CStr(Format(Month(dtLook), "00"))
sYear = CStr(Year(dtLook))
sDate = Format(Day(dtLook), "00") & sMonth & sYear
'EXAMPLES:
'http://www.nseindia.com/content/historical/EQUITIES/2010/SEP/cm20SEP2010bhav.csv.zip
'http://www.nseindia.com/content/historical/DERIVATIVES/2009/SEP/fo18SEP2009bhav.csv.zip
'http://www.bseindia.com/bhavcopy/eq180909_csv.zip
'http://www.bseindia.com/BSEDATA/gross/2009/SCBSEALL1809.zip
'http://www.nseindia.com/archives/equities/mto/MTO_18092009.DAT
'Loop through all 5 websites
For i = 1 To 5
Select Case i
Case 1
sFileName = "http://www.nseindia.com/content/historical/EQUITIES/" & sYear & "/" & sMonth & "/cm" & sDate & "bhav.csv.zip"
Case 2
sFileName = "http://www.nseindia.com/content/historical/DERIVATIVES/" & sYear & "/" & sMonth & "/fo" & sDate & "bhav.csv.zip"
Case 3
sFileName = "http://www.bseindia.com/bhavcopy/eq" & sDay & iMonth & sYear & "_csv.zip"
Case 4
sFileName = "http://www.bseindia.com/BSEDATA/gross/" & sYear & "/SCBSEALL" & sDay & iMonth & ".csv.zip"
Case 5
sFileName = "http://www.nseindia.com/archives/equities/mto/MTO_" & sDay & iMonth & sYear & ".DAT"
End Select
'sFilename
aURLs(i, 1) = sFileName
'aNames
aURLs(i, 2) = Split(sFileName, "/")
'vFolderName
aURLs(i, 3) = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
'vSaveFileName
aURLs(i, 4) = aURLs(i, 3) & aURLs(i, 2)(UBound(Split(sFileName, "/")))
'Check if the file exists locally in this location first
If Len(Dir(CStr(aURLs(i, 4)), vbNormal)) = 0 Then
'Download the file first to the Desktop
ret = URLDownloadToFile(0, aURLs(i, 1), aURLs(i, 4), 0, 0)
'See if the download happened correctly
If ret = 0 Then
'all went well
Else
'Something went wrong, grab the URL and pass for error messaging
' sErr = sErr & Format(dtLook, "mmm d, yyyy") & NL
sErr = sErr & aURLs(i, 1) & NL
Exit Sub
End If
Else
If MsgBox("The file is already downloaded. Continue anyway?", vbYesNo, "CONTINUE?") <> vbYes Then Exit Sub
End If
'Check if it is a zip file, if so, extract it
If UCase(Right(aURLs(i, 4), 4)) = ".ZIP" Then
'Set extraction name (same of file, less the ".zip" at the end)
sExtractFileName = Split(aURLs(i, 4), "\")(UBound(Split(aURLs(i, 4), "\")))
sExtractFileName = Left(sExtractFileName, Len(sExtractFileName) - 4)
'Do the actual extraction
Set oApp = CreateObject("Shell.Application")
For Each vFile In oApp.Namespace(aURLs(i, 4)).items
If Len(Dir(CStr(vFile), vbNormal)) <> 0 Then
If MsgBox(CStr(vFile) & " already exists. Delete and replace?", vbYesNo, "REPLACE?") = vbYes Then
Kill aURLs(i, 3) & CStr(vFile)
oApp.Namespace(aURLs(i, 3)).CopyHere oApp.Namespace(aURLs(i, 4)).items.Item(CStr(vFile))
End If
Else
oApp.Namespace(aURLs(i, 3)).CopyHere oApp.Namespace(aURLs(i, 4)).items.Item(CStr(vFile))
End If
' oApp.Namespace(vFolderName).CopyHere oApp.Namespace(vSaveFileName).items.Item(CStr(vFile))
Next vFile
'Clean up zip files
If CLEANUP Then
Kill aURLs(i, 4)
End If
End If
Next i
End Sub
Public Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
With Application
If Not blnState And Not ActiveWorkbook Is Nothing Then .Calculation = xlCalculationManual
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
If blnState And Not ActiveWorkbook Is Nothing Then .Calculation = xlCalculationAutomatic
End With
End Sub
