PDA

View Full Version : Solved: how do I save an xls as an xlsx after changes are made in VBA?



ckelley1020
03-21-2011, 09:54 AM
Hi everyone. I am trying to make changes and then save my ss as an xlsx, not an xls. The reason for that is I need to have all my ss's in that format for a macro I am running. If the ss's are saved as an xls, my macron fails when I try to read through 300-400 of them and pull out information from each to the main workbook. I think I am doing this right, but is does not work. I am forced to save all my ss's by hand from xls to xlsx one by one.

Thanks in advance for any help on this one.

Sub FindText()
Dim wb As Workbook, wbF As Workbook
Dim s As Worksheet, wsF As Worksheet
Dim r As Range
Dim str_File As String
Dim str_Path As String
Dim i As Long
Dim lastrow As Long
Dim LastRowCol As Long
Dim totaltext As Long
Dim totalcount As Long

i = 1
Set wbF = ThisWorkbook
'Name of sheet where results will go
Set wsF = wbF.Sheets("Results")
'Directory where files are stored
str_Path = "P:\data\test code\test files\"
str_File = Dir(str_Path & "*.xlsx")
Do While str_File <> ""

'Set wb = Workbooks.Open(str_Path & str_File, False, True)!!!!Use for no updates of wb's
Set wb = Workbooks.Open(str_Path & str_File, True, False)
For Each s In wb.Sheets

Columns("C:C").ColumnWidth = 50
Columns("D:D").ColumnWidth = 25
Columns("E:E").ColumnWidth = 25
Columns("F:F").ColumnWidth = 25
Columns("G:G").WrapText = True

lastrow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
totaltext = lastrow + 2
totalcount = totaltext - 1

Range("G" & totaltext).Value = "Total Elements"
Range("H" & totaltext).Formula = "=COUNT(H1:H" & totalcount & ")"
'Application.End(x1down).Offset(1, 0).Select

i = i + 1
Next s

wb.Save
wb.Close True
'Selection.End(xlToLeft).Select
'Selection.Offset(1, 0).Select
str_File = Dir
Loop
End Sub

mdmackillop
03-21-2011, 10:04 AM
What version of Excel are you working in when you run your macro?

ckelley1020
03-21-2011, 10:11 AM
I am pulling the data from SAP which saves the file as a spreadsheet with an extension of .xls. I am assuming that is 2003. I am using 2007 on my laptop. I have tried to save it otherwise during the save step in SAP to no avail.

Kenneth Hobs
03-21-2011, 10:26 AM
XLSX format strips the macro code. If you don't want that, save as an XLS or XLSM.

ckelley1020
03-21-2011, 11:54 AM
I wasn't sure how to make that happen. I think I figured it out.

I changed my code (in purple) to have a few new definitions and changed my wb.save to wb.saveas with a new filename using the xlsx extension AND the fileformat. If you do not do the fileformat, the Excel thinks the file is corrupted and will not open the file, which would make the entire process wirthless.



Sub FindText()
Dim wb As Workbook, wbF As Workbook
Dim s As Worksheet, wsF As Worksheet
Dim r As Range
Dim str_File As String
Dim str_Path As String
Dim str_Path_New As String
Dim i As Long
Dim lastrow As Long
Dim LastRowCol As Long
Dim totaltext As Long
Dim totalcount As Long
Dim pos As Variant

i = 1
Set wbF = ThisWorkbook
'Name of sheet where results will go
Set wsF = wbF.Sheets("Results")
'Directory where files are stored
str_Path = "H:\data\Counts\Testy\xls\"
str_Path_New = "H:\data\Counts\Testy\xlsx\"
str_File = Dir(str_Path & "*.xls")
Do While str_File <> ""

Set wb = Workbooks.Open(str_Path & str_File, True, False)
For Each s In wb.Sheets

Columns("C:C").ColumnWidth = 50
Columns("D:D").ColumnWidth = 25
Columns("E:E").ColumnWidth = 25
Columns("F:F").ColumnWidth = 25
Columns("G:G").WrapText = True

lastrow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
totaltext = lastrow + 2
totalcount = totaltext - 1

Range("G" & totaltext).Value = "Total Elements"
Range("H" & totaltext).Formula = "=COUNT(H1:H" & totalcount & ")"

wsF.Cells(i, 1).Value = wb.FullName
wsF.Cells(i, 2).Value = s.UsedRange.Find("Total Elements").Offset(0, 1).Value


i = i + 1
Next s

'wb.Save
pos = InStrRev(str_File, ".")
str_FileOnly = Left(str_File, pos - 1)
new_filename = str_Path_New & str_FileOnly & ".xlsx"

wb.SaveAs new_filename, xlOpenXMLWorkbook



wb.Close True

str_File = Dir
Loop
End Sub