Saving and modifying downloaded Read-Only files (with a twist) 2

[Marisoleil]

Hello,

I have a code that works 'some of the time'. Its purpose is to hyperlink to a set of URL's (listed in a column in Excel spreadsheet), which are addresses that automatically begin downloads when navigated to.

Normally, once navigated to on the web, these sites present the surfer with a prompt to Open or Save the download, which arrives as a csv Excel file (but not in read-only form).

With the code I've written below, the prompt for open/save doesn't come up, but the file automatically comes as a Read-Only Excel File, and with a different file name than when surfing to the site.

The problem is: Sometimes this code works, all the way through, and the folder and file(s) are saved. Other times, it stops at the Read-Only file, doesn't re-name it (by SaveAs Method), and doesn't create a new folder or file(since it needs the non read-only file to do so).


p.s. Even if you don't see the possible reason for why the code is not always working, don't hesitate to let me know if you see any 'sloppy' coding. I am always wanting to learn more robust, time-efficient and conflict-free ways to code.

Sub TestOpenURL()

' To loop through the cells in column F (stops at a blank cell):
Dim x%
x = 18
'Do While Cells(x, "F").Value <> " "  (I haven't activated this yet, I'm still running the code for just one website)

ActiveWorkbook.FollowHyperlink Address:=Cells(x, 6), NewWindow:=True

'Following code saves downloaded file as normal (rather than Read-Only as the download arrives in, (possibly due to having bypassed the open/save prompt window during download))
'This file will be deleted later by this macro, but I suspect it is necessary to first save a non-read-only copy, in order to extract info from cells within this file to help define its new file name to be saved with.
'Since the location to save the file hasn't been specified, it will automatically be saved in current folder. I WOULD LIKE TO SPECIFY A LOCATION, AS IT MAKES DELETING IT EASIER LATER.  However, for some reason, the procedure gets buggy if I put a path in here.  I've tried many different places, eg. "C:\temp\" & "NewFile.xls".  Doesn't seem to work.

If ActiveWorkbook = ReadOnly Then
    ActiveWorkbook.SaveAs Filename:="NEWFILE" & ".xls", FileFormat:=xlNormal
End If

Dim StationName, StationID As String
Dim UpdateMonth As Integer
Dim UpdateYear As Integer

StationName = ActiveWorkbook.ActiveSheet.Cells(1,2)
StationID = ActiveWorkbook.ActiveSheet.Cells(6, 2)
UpdateMonth = ActiveWorkbook.ActiveSheet.Cells(18, 3)
UpdateYear = ActiveWorkbook.ActiveSheet.Cells(18, 2)

'Following code create a custom-format timestamp with today's date
Dim MyStr As String
MyStr = Format(Date, "yyyy-mm-dd")

'Following code is to create a folder in .datain with today's date and the station name, but only if folder doesn't already exist (Thanks to someone on this site for the code, by the way! :D )
Dim fso
Dim fol As String
fol = "S:\01 JOBS\job1094-Canadian Wind Index\data.in\" + MyStr + " " + StationName
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fol) Then
    fso.CreateFolder (fol)
End If

ActiveWorkbook.SaveAs Filename:="S:\01 JOBS\job1094-Canadian Wind Index\data.in\" & MyStr & " " & StationName & "\" & UpdateYear & "_" & UpdateMonth & "_" & StationName & "_" & StationID & ".xls", FileFormat:=xlNormal
'
'I'd like to delete the proxy file I created temporarily now.  But I'm not sure yet that this is the right command below.
'NewFile.xls.Delete 

'  x = x + 1
'Loop

End Sub

I suspect there's more than one way to do this. Any comments or suggestions welcome.

Thanks

Marie

 

[SkipVought]

Hi,

Right off this statement is not valid...

    If ActiveWorkbook = ReadOnly Then
        ActiveWorkbook.SaveAs Filename:="NEWFILE" & ".xls", FileFormat:=xlNormal
    End If

rather...

[b]
    If ActiveWorkbook.ReadOnly Then[/b]
        ActiveWorkbook.SaveAs Filename:="NEWFILE" & ".xls", FileFormat:=xlNormal
    End If

Why concatenate 2 literals?

Filename:="NEWFILE" & ".xls"

rather...

Filename:="NEWFILE.xls"

But, do you want the same filename in the loop you have commented out?

Maybe you want something like

Filename:="NEWFILE" & format(Now, "yyyymmddhhnnss") & ".xls"

to make each filename unique.



Skip,
[sub]
When a wee mystic is on the loose..
It's a Small Medium at Large! [/sub]

 

[JerryKlmns]

No fso needed to create the folder if not existed

If Dir(fol, vbDirectory) Then Mkdir(fol)

No fso to delete a file

Kill "NEWFILE.xls"

Or the fso way
fso.DeleteFile("C:\NEWFILE.xls")

BTW if you do save the downloaded file without checking the readOnly property and name it as you wish then there is no need to delete the proxy file you created temporarily

 

[Marisoleil]

Thanks, Jerry. Thank you, Skip. Stars all around.

The program is still only working 'some of the time', however.

I used all your suggestions, Skip, except for adding the to-the-second timestamp (I like the idea, but then I can't as easily identify these files to later delete). I'm hoping this won't pose a problem once the loop is added in, but if it does, I was thinking I could also add the 'x' from the loop into the filename. Originally, I did have the 'If ReadOnly Then' line with the notation you suggested, but I took out the 'if then' statement as I thought it wasn't necessary as the file is always Read-Only. Incidentally, the file also always arrives with the same name ("bulkdata_e.html"). Do you think it might help the problem if I referred to the newly downloaded file by name, instead of ActiveWorkbook when executing the command to rename it? I was wondering if this is all a question of 'timing' -that is, maybe what's varying is how long it takes for the page to download and 'become' the new activeworkbook (rather than the Excel workbook that I'm running the procedure out of). However, it never happens that the old workbook gets renamed and saved, so maybe that discredits that theory.


Jerry, you are correct, of course, if I save the downloaded file without checking if it's ReadOnly and naming it, then there's no need to delete the temp proxy file. However, I am going through these steps so that I can extract info contained in cells in the downloaded Excel spreadsheet to contribute to the name that the file is ultimately saved with. (I thought the program wasn't working before, as I couldn't extract info from cells while it was ReadOnly..Is this a correct assumption?)

 

[Marisoleil]

P.S. Jerry, regarding the folder creation: I lifted that code from tech-tips faq707-4116. I tried your suggestion:

'Following code is to create a folder in .datain with today's date and the station name, but only if folder doesn't already exist
'Dim fso
Dim fol As String
fol = "S:\01 JOBS\job1094-Canadian Wind Index\data.in\" & MyStr & " " & StationName
If Dir(fol, vbDirectory) Then MkDir (fol)
'Set fso = CreateObject("Scripting.FileSystemObject")
'If Not fso.FolderExists(fol) Then
'    fso.CreateFolder (fol)
'End If

Also, I tried commenting out all the code below creating the NEWFILE.xls, and the program still only works 'some of the time'.

I tried an Application.Wait command, and didn't have luck with it.


If you've read this far, and are still with me, you really deserve a star, Thank you!

Marie

 

[Marisoleil]

Hi Again,

Progress! (Some)

I believe I have zeroed in on the problem: When one of the URL's is navigated to in Explorer, there is a short (perhaps 1 sec or less) delay the duration of which seems to vary (on the server's side) before open/save prompt comes up.

I suspect that when the delay is longer, there is the chance for the download to be snagged somehow. But if it's a longer delay and the prompt window comes up, then the code fails.

Reason I think this: I managed to view download page source (actual webpage is blank and only remains open for less than a couple seconds) in that short delay, and it has the name "bulkdata_e.html", which is what the downloaded Excel sheet arrives as, when the code works.

When the open/save prompt is manually engaged (not through the code) the file arrives with another name.

So, where to go from here? Since I can't control the delay on the side of the server, I could write code with some kind of if-then statement to be able to handle both possibilities. Not sure yet how to do this, as I don't know how to handle the prompt yet. (Can't be too hard, right?)

Any suggestions, comments?

Marie

 

[Marisoleil]

Had success going different route. I am heading out of office, but will post my solution for future reference and curious minds on Monday.

Have a good weekend everybody

Marie

 

[Marisoleil]

Hello All,
As promised, here is my final successful code. The only tiny problem I am experiencing is that although I have the Do While loop specifying to stop at an empty cell, the cells actually contain formulae, so even when empty, this do while code doesn't seem to work at stopping the loop, and so an error is returned upon completion of running the procedure. If anyone has any suggestions for how to rectify this, please let me know. Thanks again for help along the way with this one.

Cheers,
Marie

Sub MacroTest()
    
    Dim x%                                
    x = 18
    Do While Cells(x, "F").Value <> " "
    
    Workbooks("Aut dwnlds.xls").Sheets("Sheet1").Activate
    Cells(x, "F").Select
    Selection.Copy
    Application.CutCopyMode = False
    Dim pickme As String
    pickme = Cells(x, 6)
    Workbooks.Open Filename:=pickme
    Range("B1").Select
    
Dim StationName, StationID As String
Dim UpdateMonth As Variant
Dim UpdateYear As Integer

'Extracting StationName from downloaded Excel Monthly Update
StationName = ActiveWorkbook.ActiveSheet.Cells(1, 2)

'Extracting StationID
StationID = ActiveWorkbook.ActiveSheet.Cells(6,2)      

'Extracting Month of particular update sheet
UpdateMonth = ActiveWorkbook.ActiveSheet.Cells(18, 3)

'Extracting Year of particular update sheet
UpdateYear = ActiveWorkbook.ActiveSheet.Cells(18, 2)
       
'Following code creates a custom-format timestamp with today's date
Dim MyStr As String
MyStr = Format(Date, "yyyy-mm-dd")

'Following code is to create a folder in "data" folder with today's date and the station name, but only if folder doesn't already exist
Dim fso
Dim fol As String
fol = "S:data\" & MyStr & " " & StationName
'If Dir(fol, vbDirectory) Then MkDir (fol)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fol) Then
    fso.CreateFolder (fol)
End If
        
ActiveWorkbook.SaveAs Filename:="S:data\" & MyStr & " " & StationName & "\" & UpdateYear & "_" & UpdateMonth & "_" & StationName & "_" & StationID & ".xls", FileFormat:=xlNormal
         
x = x + 1
Loop

End Sub