See my comment amidst your code, below...


On Sat, 21 Nov 2009 16:52:03 -0800, Joel
wrote:

You will see this code twice because I posted at moth MS and thecodecage.
thecodecage just started a new poclicy of not posting until somebody at
thecodecage as reviewed the posting. thsi will slow down the postings. MS
just waits about 5 minutes before a postijng is updatedc but the MS site
isn't maintained and it often broken for days before MS repairs the site.

Read my other comments from the code cage when they show up.


Sub DVD_List_Converter_for_Office_2007_Use()
'
' DVD_List_Converter_for_Office_2007_Use Macro
'
' Converts the three sheet, Office 97/2003 workbook into a
' single sheet, Office 2007 workbook for better use as a
' large flat file database.
'
'
FName = "dvdlist.zip"
AppData = Environ("APPDATA")
Filename = AppData & "\" & FName

FNameXLS = FName
'remove extension
FNameXLS = Left(FName, InStrRev(FName, "."))
FNameXLS = AppData & "\" & FNameXLS & "xls"

I think I need to insert the WinRar extract code segment in here
or the above FName should directly be the .xls file name.


Set bk = Workbooks.Open(FNameXLS)
Set Newbk = Workbooks.Add(template:=xlWBATWorksheet)
Newbk.SaveAs Filename:="D:\Temp\dvdlist\DVDList1.xlsx", _
FileFormat:=xlOpenXMLWorkbook
Set NewSht = Newbk.Sheets(1)
NewSht.Name = "DVDs"
With bk
'combine sheets 2 and 3 to sheet 1
For ShtCount = 1 To 3
LastRow = NewSht.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:=NewSht.Rows(NewRow)
Next

With NewSht
'find ID column
Set C = .Rows(1).Find(what:="ID", _
LookIn:=xlValues, lookat:=xlWhole, _
MatchCase:=False)
C.EntireColumn.Cut
.Columns("A").Insert

End With

bk.Close savechanges:=False
Newbk.Save
End With

End Sub

I will try this and see if it works.

thanks again.

Meow




"MeowSayTongue" wrote:

Here is my conversion code.

There seems to be a problem when selecting entire rows from a 2k3 sheet
and attempting to paste them into a 2k7 sheet. I have tried all methods,
as in 'values only', etc. It still pukes. I can only select the data
block itself and paste it, so I would need a code segment that always
finds the last entry in the sheet, and only places that block on the copy
cache. Then, it pastes just fine.

I did not place any of your zip file management into my routine.

I want to make an "import new files" routine for that one, and a
"Convert" routine as I have here, for the conversion and final save.

It adds one additional button to the list, but lets the user bypass the
DL if he already has the file on hand. Unless a user query could be
added at that point to convert the existing file or grab the new one
first.

My code:




Sub DVD_List_Converter_for_Office_2007_Use()
'
' DVD_List_Converter_for_Office_2007_Use Macro
'
' Converts the three sheet, Office 97/2003 workbook into a
' single sheet, Office 2007 workbook for better use as a
' large flat file database.
'
'
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\Temp\dvdlist\DVDList1.xlsx",
FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "DVDs"
Workbooks.Open Filename:="D:\Temp\dvdlist\dvdlist.xls"
Sheets("a-f").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("DVDList1.xlsx").Activate
ActiveSheet.Paste
Windows("dvdlist.xls").Activate
Sheets("g-o").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("DVDList1.xlsx").Activate
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A58887").Select
ActiveSheet.Paste
Range("A58888").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A115010").Select
Windows("dvdlist.xls").Activate
Sheets("p-z").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("DVDList1.xlsx").Activate
ActiveSheet.Paste
Columns("N:N").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.Close
End Sub

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
.

.

.