Solved

Follow Up FO

Posted on 2015-01-19
13
83 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
 
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

744 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now