Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Follow Up FO

Posted on 2015-01-19
13
Medium Priority
?
125 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:Naresh Patel
  • 7
  • 6
13 Comments
 
LVL 31

Expert Comment

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

Author Comment

by:Naresh Patel
ID: 40557890
Yes Sir.
0
 
LVL 31

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
Fill in the form and get your FREE NFR key NOW!

Veeam is happy to provide a FREE NFR server license to certified engineers, trainers, and bloggers.  It allows for the non‑production use of Veeam Agent for Microsoft Windows. This license is valid for five workstations and two servers.

 
LVL 8

Author Comment

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

Thanks
0
 
LVL 31

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:Naresh Patel
ID: 40558143
Do you mean this AdressThanks
0
 
LVL 31

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:Naresh Patel
ID: 40558175
Done Sir, downloading Fine - Now Unzipping - Formatting - Text File.

Thanks
0
 
LVL 31

Expert Comment

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

Author Comment

by:Naresh Patel
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 31

Accepted Solution

by:
gowflow earned 2000 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:Naresh Patel
ID: 40558376
Perfect - May I Ask follow Up?
0
 
LVL 8

Author Comment

by:Naresh Patel
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

Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

Question has a verified solution.

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

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
In this post, I will showcase the steps for how to create groups in Office 365. Office 365 groups allow for ease of flexibility and collaboration between staff members.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
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…

886 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