Consulting

Results 1 to 5 of 5

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

  1. #1

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

    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.

    [VBA]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").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[/VBA]

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    What version of Excel are you working in when you run your macro?
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    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.

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    XLSX format strips the macro code. If you don't want that, save as an XLS or XLSM.

  5. #5
    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").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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •