• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 140
  • Last Modified:

Follow Up FO

Hi Experts,

I have one file with macro which download data from web as zip - unzipped the file - format - as save as .txt file.

Need to add one more step before above mention procedure.
if I will put start date & TODAY() in cells it will download zip files for that duration from web and print last available file date as start date.

See attached

any further clarification pls let me know.

Thanks
Incoporated-Download-File-V05.xlsm
0
Naresh Patel
Asked:
Naresh Patel
  • 7
  • 6
1 Solution
 
gowflowCommented:
Are we talking about the FO ? and to download in zip ?
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Yes Sir.
0
 
gowflowCommented:
ok here it is:

1) Make a copy of your latest workbook and give it a new name
2) Open VBA and doubleclick on the module aStartFO
3) Paste the below code after any End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DownloadFileFO
' This downloads a file from a URL to a local filename.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function DownloadFileFO(Overwrite As DownloadFileDisposition) As Boolean
    Dim WSMain As Worksheet
   
    Dim DestinationFileName As String
    Dim Disp As DownloadFileDisposition
    Dim Res As VbMsgBoxResult
    Dim ErrorText As String
    Dim B As Boolean
    Dim S As String
    Dim L As Long
    Dim MaxRowM As Long
    
    '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
    Dim sLastDownloadeddate As String
    Dim oFso As Object

    
    Set WSMain = ActiveSheet

    '---> Clean Previous Trace
    WSMain.Range("A14:I" & WSMain.Rows.Count).ClearContents
    MaxRowM = 14
    
    
    ErrorText = vbNullString

    strSavePath = gstDestinationFolder
    
    If Not bTrace Then
        WSMain.Cells(14, "A").EntireRow.Insert
        WSMain.Cells(14, "A") = "Furture & Options"
        WSMain.Cells(14, "B") = strSavePath
        WSMain.Cells(14, "C") = "*.*"
        WSMain.Cells(14, "F") = "Deleting"
        'MaxRowM = MaxRowM + 1
    End If
    
    '---> Delete All files in Directory prior to proceeding
    DeleteFiles strSavePath
    
    Set oFso = CreateObject("Scripting.FileSystemObject")

    With oFso
        If Not .FolderExists(strSavePath) Then
            MakeMultiStepDirectory strSavePath
        End If
    End With

    'iYear = 2014
    'Do
    '    On Error Resume Next
    '    iYear = InputBox("Please Enter Year to Process", "Year Input", Year(Now))
    'Loop Until Err = 0 And iYear >= 1900
    
    If dEndDate = vbEmpty Or dStartDate = vbEmpty Then
        MsgBox "Missing either Strat Date or End Date procedure will exit.", vbCritical
        Exit Function
    End If
    
    datLastDate = DateValue(dEndDate)      'DateSerial(iYear, 4, 9)
    datWorkDate = DateValue(dStartDate)    'DateSerial(iYear, 1, 1)
    
    
    Do
        'http://www.nseindia.com/content/historical/DERIVATIVES/2015/JAN/fo02JAN2015bhav.csv.zip
        strMonth = UCase(Format(datWorkDate, "MMM"))  ' upper case name of the month, like JAN
        iYear = Year(datWorkDate)
        strFileName = "fo" & Right("0" & Day(datWorkDate), 2) & strMonth & iYear & "bhav.csv.zip"    ' e.g. fo01JAN2013bhav.csv.zip
        'strFilePath = "http://www.nseindia.com/content/historical/DERIVATIVES/" & iYear & "/" & strMonth & "/" & strFileName
        strFilePath = sHTTP & iYear & "/" & strMonth & "/" & strFileName
        
        If Right(strSavePath, 1) <> "\" Then strSavePath = strSavePath & "\"

        DestinationFileName = strSavePath & strFileName

        If Dir(DestinationFileName, vbNormal) <> vbNullString Then
            Select Case Overwrite
                Case OverwriteKill
                    On Error Resume Next
                    Err.Clear
                    Kill DestinationFileName
                    If Err.Number <> 0 Then
                        ErrorText = "Error Killing file '" & DestinationFileName & "'." & vbCrLf & Err.Description
                        DownloadFileFO = False
                    End If

                Case OverwriteRecycle
                    On Error Resume Next
                    Err.Clear
                    B = RecycleFileOrFolder(DestinationFileName)
                    If B = False Then
                        ErrorText = "Error Recycleing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                        DownloadFileFO = False
                        Exit Function
                    End If

                Case DoNotOverwrite
                    DownloadFileFO = False
                    ErrorText = "File '" & DestinationFileName & "' exists and disposition is set to DoNotOverwrite."
                    Exit Function

                    'Case PromptUser
                Case Else
                    S = "The destination file '" & DestinationFileName & "' already exists." & vbCrLf & _
                        "Do you want to overwrite the existing file?"
                    Res = MsgBox(S, vbYesNo, "Download File")
                    If Res = vbNo Then
                        ErrorText = "User selected not to overwrite existing file."
                        DownloadFileFO = False
                        Exit Function
                    End If
                    B = RecycleFileOrFolder(DestinationFileName)
                    If B = False Then
                        ErrorText = "Error Recycling file '" & DestinationFileName & "." & vbCrLf & Err.Description
                        DownloadFileFO = False
                        Exit Function
                    End If
            End Select
        End If
        Debug.Print strFilePath & " validity: " & GetURLStatus(strFilePath)
        If GetURLStatus(strFilePath) = "200 - OK" Then
            L = DeleteUrlCacheEntry(strFilePath)
            L = URLDownloadToFile(0&, strFilePath, DestinationFileName, 0&, 0&)
            Select Case L
                Case Is = 0
                    DownloadFileFO = True
                    sLastDownloadeddate = datWorkDate
                    
                    '---> Update Trace
                    If Not bTrace Then
                        WSMain.Cells(14, "A").EntireRow.Insert
                        WSMain.Cells(14, "A") = "Furture & Options"
                        WSMain.Cells(14, "B") = strSavePath
                        WSMain.Cells(14, "C") = strFileName
                        WSMain.Cells(14, "F") = "Created"
                        'MaxRowM = MaxRowM + 1
                    End If
                Case Is = -2146697210
                    ErrorText = "File not found."
                    DownloadFileFO = False
                Case Is = -2146697211
                    ErrorText = "Domain not found."
                    DownloadFileFO = False
                Case Is = -2147467260
                    ErrorText = "Transfer aborted."
                    DownloadFileFO = False
                Case Else
                    ErrorText = "Buffer length invalid or not enough memory."
                    DownloadFileFO = False
            End Select
        End If
        datWorkDate = DateAdd("d", 1, datWorkDate)
    Loop Until datWorkDate > datLastDate

'---> Set New Start Date = last successful date + Clear End Date
If sLastDownloadeddate <> "" Then
    Range("E6").Value = DateAdd("d", 1, sLastDownloadeddate)
    Range("F6").Formula = "=Today()"
    'MsgBox "Last Successful downloaded file was on " & sLastDownloadeddate & Chr(10) & "The next set date for next run of the routine will be set at " & Range("G3").Value
Else
    Range("F6").Formula = "=Today()"
    'MsgBox "No Files where found in this Interval try later."
End If
End Function

Open in new window


4) SAVE the workbook.
5) doubleclick on the Sheet Main still in VBA
6) choose the commandbutton4 code and delete all the code that is between the first line click and End Sub
CommandButton4_Click

...

End Sub

7) Paste the below code after CommandButton_Click

bTrace = CheckBox21.Value
bAudit = CheckBox22.Value
gstDestinationFolder = Range("B6")
If bTesting Then gstDestinationFolder = ActiveWorkbook.Path & "\Temp\"
dStartDate = Range("E6")
dEndDate = Range("F6")
sHTTP = Sheets("Settings").Range("B5")

'---> Start Download
DownloadFileFO (OverwriteRecycle)

'---> Formating FO
'FormatingFO CommandButton4.Caption, gstDestinationFolder

MsgBox ("Process Future & Options Completed")

Open in new window


8) SAVE the workbook and close it.
9) Open it and give it a try.

Note at this stage we need to disable the formatting as it is supposed to come after you finish the whole thing on this module.

This part will download the zip file and always when it starts it delete all files in the said directory.

Let me know.
gowflow
0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
Naresh PatelTraderAuthor Commented:
it just deleted from directory. No Downloading.

Thanks
0
 
gowflowCommented:
what date did you put. I tried it and here it is

xip files
Opps !!!

Just forgot to mention that in settings the address should be:
http://www.nseindia.com/content/historical/DERIVATIVES/

Sorry for this my fault. Just remove everything after the backslash of DERIVATIVES/
and try it again.

gowflow
0
 
Naresh PatelTraderAuthor Commented:
Do you mean this AdressThanks
0
 
gowflowCommented:
NOOOOOO !!!!

don't touch the code !!!! please

In sheet Settings
replace cell B5 this
http://www.nseindia.com/content/historical/DERIVATIVES/2015/JAN/fo02JAN2015bhav.csv.zip


by this
http://www.nseindia.com/content/historical/DERIVATIVES/

save and try it. Get your code the way it was.
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Done Sir, downloading Fine - Now Unzipping - Formatting - Text File.

Thanks
0
 
gowflowCommented:
ok go ahead
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Do you want me to ask new question for the same ? As unziping - formatting - TEXT file is already solved in previous question.

Thanks
0
 
gowflowCommented:
ok here it is:

1) open VBA
2) doubleclick on sheet Main and delete all the code that is in commandbutton4
3) Paste the below code in commandbutton4

bTrace = CheckBox21.Value
bAudit = CheckBox22.Value
gstDestinationFolder = Range("B6")
If bTesting Then gstDestinationFolder = ActiveWorkbook.Path & "\Temp\"
dStartDate = Range("E6")
dEndDate = Range("F6")
sHTTP = Sheets("Settings").Range("B5")

'---> Clear Previous Trace
If Not bTrace Then
    Sheets("Main").Range("A14:I" & Sheets("Main").Rows.Count).ClearContents
End If

'---> Start Download
DownloadFileFO (OverwriteRecycle)

'---> Part of Unzipping files
UnzipAllFiles CommandButton4.Caption

'---> Formating FO
FormatingFO CommandButton4.Caption, gstDestinationFolder

MsgBox ("Process Future & Options Completed")

Open in new window


4) Save and exit the workbook
5) Open it and try it.

gowflow
0
 
Naresh PatelTraderAuthor Commented:
Perfect - May I Ask follow Up?
0
 
Naresh PatelTraderAuthor Commented:
Here it is.

This second last which I forgot to mention in past for formatting. And last one I need one master button so if I clicked that all 6 buttons process is done without any popup message at one click.

Thanks
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now