Home |
Search |
Today's Posts |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Wow, thanks, Joel. That looks awesome. I would only need to edit the
location of winrar call. Does that take the conversion into account? Because this file will not go past a 65k row sheet, and adding those together has to take place on the new Excel 2007 type sheet. type .xlsx So, would I not need to add a "workbooks.new" (or the like)routine in there and "import" the 2k7 .xls sheets to it before the last routine, which would then be working with the .xlsx file as well at that point? Thanks again, that is awesome, and each time I get help, I gain a bit more knowledge about modern paradigms and structures and syntaxes, as compared to my 286 Paradox relational database days, which only lasted a few years and was a long time ago. Meow On Sat, 21 Nov 2009 06:32:02 -0800, Joel wrote: this task is pretty simple if you just want to modify the XLS file. but if you want to download and unziop the file automatically it is more complicated. I put the downloaded and unzip file in you document and Setting folder. Just start the code and DO NOTHING. the download portion of the code needs to use the active window so don't do anythin on your PC until the file starts to download and the check box to close the download window is checked. Sub unzipcode() FName = "dvdlist.zip" 'URL = "http://www.hometheaterinfo.com/dvdlist.htm" URL = "http://www.hometheaterinfo.com/download/" 'http://www.hometheaterinfo.com/download/dvdlist.zip FName = "dvdlist.zip" AppData = Environ("APPDATA") Filename = AppData & "\" & FName FNameXLS = FName 'remove extension FNameXLS = Left(FName, InStrRev(FName, ".")) FNameXLS = AppData & "\" & FNameXLS & "xls" 'remove ZIP file before downloading so message 'do you want to remove file doesn't show up 'in download window FileFound = Dir(Filename) If FileFound < "" Then Kill Filename End If Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True 'get web page IE.Navigate2 URL & FName 'wait 5 seconds Application.Wait (Now + TimeValue("0:00:05")) 'send ALT - S to save file ActiveWindow.Application.SendKeys ("%S"), True 'select the filename box ActiveWindow.Application.SendKeys ("%n"), True ActiveWindow.Application.SendKeys (Filename), True 'press save button to start downloading ActiveWindow.Application.SendKeys ("%S"), True 'wait 5 seconds before click button below Application.Wait (Now + TimeValue("0:00:05")) 'press button to closedownload file when complete ActiveWindow.Application.SendKeys ("%C"), True 'wait untiule file is downloaded Do Downloadfile = Dir(Filename) DoEvents Loop While Downloadfile = "" 'remove xls file if exists before opening new one FileFound = Dir(FNameXLS) If FileFound < "" Then Kill FNameXLS End If WinRarPath = "C:\Program Files\WinRar\" CommandStr = _ """" & WinRarPath & "WinRar.exe"" e" & _ " """ & Filename & """" & _ " *.xls """ & AppData & """" Range("A1") = CommandStr RarIt = Shell(CommandStr, vbNormalFocus) 'remove read only attribute CommandStr = "Attrib -R " & FNameXL RemoveReadOnly = Shell(CommandStr, vbNormalFocus) 'wait 5 seconds Application.Wait (Now + TimeValue("0:00:05")) Set bk = Workbooks.Open(FNameXLS) With bk 'combine sheets 2 and 3 to sheet 1 For ShtCount = 2 To 3 LastRow = .Sheets(1).Range("A" & Rows.Count).End(xlUp).Row NewRow = LastRow + 1 LastRow = .Sheets(ShtCount).Range("A" & Rows.Count).End(xlUp).Row 'copy data to sheet 1 .Sheets(ShtCount).Rows("1:" & LastRow).Copy _ Destination:=.Sheets(1).Rows(NewRow) Next Application.DisplayAlerts = False .Sheets(3).Delete .Sheets(2).Delete Application.DisplayAlerts = True With .Sheets(1) 'find ID column Set C = .Rows(1).Find(what:="ID", _ LookIn:=xlValues, lookat:=xlWhole, _ MatchCase:=False) C.EntireColumn.Cut .Columns("A").Insert .Name = "DVDs" End With .Close savechanges:=True End With End Sub "MeowSayTongue" wrote: I do use WinRar, and it is tied to the zip extension. I found that it will not auto-magically save as a 2k7 file, as it tries to retain compatibility. So I open a blank workbook first, and have to copy the sheets into that workbook, to get a pure 2k7 format file. Unless I am missing some technique there as well. :-) Which is entirely possible. Thanks. Meow On Fri, 20 Nov 2009 03:03:01 -0800, Joel wrote: What unzip utility are you using on your PC. the solution depends on which tool you are usings. I have WinRar and found a VBA macro on the web that will unzip the file into a folder on the PC. The macro will have to perform 3 steps 1) Download the file onto the PC 2) Unzip the file 3) Perform your changes I just want to know what folders you are using now on your PC and if you were using WinRar or some other unzip utility. "MeowSayTongue" wrote: Hello. I download a spreadsheet workbook often online that is a DVD database. I need to correct its structure and bring it into 2k7 form factor to make my use of it practical. It is located he http://www.hometheaterinfo.com/dvdlist.htm The file link is: http://www.hometheaterinfo.com/download/dvdlist.zip It is a 12.7 MB file. More unzipped. 2k3 format. What I need to do is make a small macro that converts it to a 2k7 single worksheet file, and shift one column to the leftmost position. I have been manually performing these tasks by manually saving the file in the 2k7 format, then I cut and paste the column I want shifted in each of the three worksheets labeled "a-f", "g-o", and "p-z". The column I move is the ID column to the leftmost position, in all three worksheets. After moving the ID column, I then rename "atof" to "DVDs" and then addendum the other two sections, creating a single, one worksheet flat file database. I then delete the two original middle and end worksheets. Are there not a few quick macro functions I could utilize to do this? Meow . . |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
need to automate a sheet re-organization | Excel Worksheet Functions | |||
How can I automate creating a sheet for a unique value that is bla | Excel Programming | |||
How to automate daily interest in a balance sheet? | Excel Discussion (Misc queries) | |||
Automate Autofilter Results - Copy to New Sheet | Excel Programming | |||
Automate Finding Values/Copy to Different Sheet | Excel Programming |