Solved

Follow Up FO

Posted on 2015-01-19
13
96 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
DevOps Toolchain Recommendations

Read this Gartner Research Note and discover how your IT organization can automate and optimize DevOps processes using a toolchain architecture.

 
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

The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

Question has a verified solution.

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

PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

770 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