Link to home
Start Free TrialLog in
Avatar of M Zahid
M ZahidFlag for United Arab Emirates

asked on

problem with the file save VB code

Hello Sirs,

Below Code was working perfect but now having problem while saving file as PDF, it still save the file but without any extension e.g. .pfd or .xlsb, to open the file i have choose the file type then only I can open it.


 
Dim FileExtStr As String, pdfName As String, filesavename As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim FilePath As String
    Dim FileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False

        Set Sourcewb = ActiveWorkbook
        Select Case MsgBox("Do you want to save as XLS/PDF, Yes for Xls, No for PDF", vbYesNo Or vbExclamation Or vbDefaultButton1, "File format")
        
        Case vbYes
            'Copy the sheet to a new workbook
            ActiveSheet.Copy
            Set Destwb = ActiveWorkbook

            'Determine the Excel version and file extension/format
            With Destwb
                If Val(Application.Version) < 12 Then
                    'You use Excel 97-2003
                    FileExtStr = ".xls": FileFormatNum = -4143
                Else
                    'You use Excel 2007-2016
                    Select Case Sourcewb.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If .HasVBProject Then
                            FileExtStr = ".xlsm": FileFormatNum = 52
                        End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                    End Select
                End If
            End With

            'Change all cells in the worksheet to values if you want
            With Destwb.Sheets(1).UsedRange
                .Cells.Copy
                .Cells.PasteSpecial xlPasteValues
                .Cells(1).Select
            End With
            Application.CutCopyMode = False

            'Save the new workbook and close it
            FilePath = ThisWorkbook.Path
            FileName = "" & Sourcewb.Name


            With Destwb
                .SaveAs FilePath & "\" & FileName & FileExtStr, FileFormat:=FileFormatNum
                .Close SaveChanges:=False
            End With

            MsgBox "You can find the new file in " & FilePath
        
        Case vbNo    ''/// save as pdf
            On Error GoTo 0
            On Error Resume Next
            pdfName = ActiveWorkbook.Name
            ChDir ActiveWorkbook.Path & "\"
            filesavename = ActiveWorkbook.Name

            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
                                            filesavename _
                                          , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                                                                                                  :=False, OpenAfterPublish:=True
            MsgBox "File has been Saved :  " & " " & filesavename
        End Select
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 

Open in new window



Kindly help..

Thanks in advance
M Zahid
ASKER CERTIFIED SOLUTION
Avatar of Roy Cox
Roy Cox
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of M Zahid

ASKER

Thanks guys its works, much appreciated for your inputs.
Pleased to help