How to save all Workbooks as Microsoft Excel 2016

[Galapagos15]

For some reason when I run the VBA code below a couple of the files are being saved as a Text file instead of an Excel Workbook. I'm not sure if this has to do with our upgrade to Microsoft Excel 2016.

Can someone please assist me in added coding to the VBA below which will make sure each file is saved as Microsoft Excel 2016 Workbook so I won't have anymore issues.

Sub AddWorkbooks2()
Dim wb As Workbook, wb1 As Workbook
Dim Found As Range, lastFound As Range, First As Range
Dim LastRow As Long, i As Long, j As Long
Dim fPath As String, fName As String, newName As String, firstAddress As String, ID As String
Dim arr() As Variant
Application.ScreenUpdating = False
fPath = "C:\Kerry" 'Change to your folder path, and include the "" at the end
Set wb = ThisWorkbook
LastRow = wb.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
i = 1
Set Found = wb.Sheets(1).Range("A2:A" & LastRow).Find(What:="Totals", LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
firstAddress = Found.Address
With wb.Sheets(1)
    Do
        Set Found = .Range("A2:A" & LastRow).Find(What:="Totals", After:=Found, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
        ReDim Preserve arr(i)
        arr(i) = Found.Address
        i = i + 1
    Loop While Not Found Is Nothing And Found.Address <> firstAddress
    
    For i = 1 To UBound(arr)
        For j = i + 1 To UBound(arr)
            fName = .Range(arr(i)).Offset(-1, 0)
            If .Range(arr(i)).Offset(-1, 0) = .Range(arr(j)).Offset(-1, 0) Then
                If j = UBound(arr) Then
                    Set wb1 = Workbooks.Add
                    wb1.Sheets(1).Range("A1:ax1").Value = .Range("A1:ax1").Value
                    .Range(.Range(arr(i)), .Range("AX2")).Copy Destination:=wb1.Sheets(1).Range("A2")
                    Columns.AutoFit
                    On Error GoTo errHandler
                    wb1.SaveAs Filename:=fPath & Range(" b3").Value & (" - ") & fName & (" -") & Format(Range(" x3").Value, " mmddyyyy")
                    wb1.Close savechanges:=False
                    i = UBound(arr)
                    Exit For
                End If
            Else
                Set wb1 = Workbooks.Add
                wb1.Sheets(1).Range("A1:ax1").Value = .Range("A1:ax1").Value
                .Range(.Range(arr(i)), .Range(arr(j)).Offset(1, 49)).Copy Destination:=wb1.Sheets(1).Range("A2")
                Columns.AutoFit
                On Error GoTo errHandler
                wb1.SaveAs Filename:=fPath & Range(" b3").Value & (" - ") & fName & (" -") & Format(Range(" x3").Value, " mmddyyyy")
                wb1.Close savechanges:=False
                i = j - 1
                Exit For
            End If
        Next j
    Next i
End With
Application.ScreenUpdating = True
errHandler:
    If Err.Number = 1004 Then
        newName = InputBox(prompt:="This is a duplicate file name." & _
        vbCrLf & "Please input a unique file name.", Default:=Found & "-" & Found.Offset(1, 0).Value)
        wb1.SaveAs Filename:=fPath & Range(" b3").Value & (" - ") & newName & (" -") & Format(Range(" x3").Value, " mmddyyyy")
        Resume Next
    ElseIf Err.Number <> 0 Then
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
End Sub

Thank in advance!

 

[Norie]

Try specifying the file format when you are saving, for example.

wb1.SaveAs Filename:=fPath & Range(" b3").Value & (" - ") & fName & (" -") & Format(Range(" x3").Value, " mmddyyyy"), FileFormat:=xlOpenXMLWorkbook ' or xlOpenXMLWorkbookMacroEnabled

 

[Galapagos15]

Thank you for the information. Maybe the file has corrupt data because it still saved a couple files as Text. Thanks for trying!!!

 

[Norie]

Did you change all the SaveAs code to use FileFormat?