Solved

Follow Up FO

Posted on 2015-01-19
13
101 Views
Last Modified: 2015-01-19
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
Comment
Question by:itjockey
  • 7
  • 6
13 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 40557834
Are we talking about the FO ? and to download in zip ?
gowflow
0
 
LVL 8

Author Comment

by:itjockey
ID: 40557890
Yes Sir.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40557911
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 8

Author Comment

by:itjockey
ID: 40558058
it just deleted from directory. No Downloading.

Thanks
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40558089
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
 
LVL 8

Author Comment

by:itjockey
ID: 40558143
Do you mean this AdressThanks
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40558155
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
 
LVL 8

Author Comment

by:itjockey
ID: 40558175
Done Sir, downloading Fine - Now Unzipping - Formatting - Text File.

Thanks
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40558177
ok go ahead
gowflow
0
 
LVL 8

Author Comment

by:itjockey
ID: 40558190
Do you want me to ask new question for the same ? As unziping - formatting - TEXT file is already solved in previous question.

Thanks
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
ID: 40558210
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
 
LVL 8

Author Closing Comment

by:itjockey
ID: 40558376
Perfect - May I Ask follow Up?
0
 
LVL 8

Author Comment

by:itjockey
ID: 40558442
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

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

685 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