PDA

View Full Version : Prevent to modify file extension



amrane
09-24-2019, 02:35 AM
Dear Forum,

I want to protect some file xlsb (equipped vba code) to be saved as xlsx file, I did may search in the network, but looks the below code has inconvenient to produce endless message loops, can you support to solve this problem:

thank you sir in advance for your support




Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FD As FileDialog, FTyp As Long
Dim folderpath As String, MyWbName As String

Cancel = True

folderpath = Application.ActiveWorkbook.Path
MyWbName = Application.ActiveWorkbook.FullName

' reference a SaveAs Dialog
Set FD = Application.FileDialog(msoFileDialogSaveAs)
With FD
.FilterIndex = 3

.InitialFileName = MyWbName
.Title = "Save As"
End With

FD.Show

If FD.SelectedItems.Count = 0 Then
Exit Sub
Else
' check for proper extension
If Right(FD.SelectedItems(1), 4) = "xlsb" Then '= "xlsm" Then

FTyp = 50

Application.EnableEvents = False
Me.SaveAs FD.SelectedItems(1), FTyp
Application.EnableEvents = True

Else
MsgBox "selected wrong file format ... not saving"
End If
End If

End Sub

SamT
09-25-2019, 03:07 PM
BeforeSave Event

See Also Applies To Example (http://www.vbaexpress.com/forum/#example) Specifics

Occurs before the workbook is saved.

Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)


SaveAsUi True if the Save As dialog box will be displayed.

Cancel False when the event occurs. If the event procedure sets this argument to True, the workbook isn't saved when the procedure is finished.

Example

This example prompts the user for a yes or no response before saving the workbook.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel as Boolean)
a = MsgBox("Do you really want to save the workbook?", vbYesNo)
If a = vbNo Then Cancel = True
End Sub



_BeforeSave is an EVENT. Cancel Application Events in the sub Before running the rest of the code in the sub.
Reset Events before exiting the sub.

snb
09-26-2019, 07:24 AM
I'd use:


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = 0
ThisWorkbook.SaveAs Replace(ThisWorkbook.Name, ".xlsx", ".xlsb"), 50
End Sub

The introduction af an Addin seems to be more robust.

amrane
10-08-2019, 03:10 AM
Dear snb

thank you sir for your help, but no restrict to maintain a given file type
I think the best way is to make condition as below:
based on the "Save as Type" file type, the Save button will be enabled or not activated

please can you tell how to do it?
http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAArcAAAC9CAYAAACpmVU4AAAXYElEQVR4nO3du24j 2YEGYD5IR4tOJTBmYgUONyEg5nbCXIGgyAO9gRgIFuBn6MALAfUGu9t7ASzb48UAMmCP7Qkc9DO cDchi3U4Vq3irYun7gQ/T4qWupPjr8JAz fff/SUAAMAYTGIXTq/vQvJ6t/7v29fwfarpssp1T2ExmYTJZB5eNte93F Fye1Tdt c5P4qTO /5O57FR5eq7er9TyvXfax3NzcHCS/LBERERE5fqLl9pQFEQAAjkW5BQBgNJRbAABGQ7kFAGA0lFsAAEZDuQUAYDSUWwAARkO5BQBgNJR bAABGQ7kFAGA0PnS5fXx8BABgRD58ub25uQEAYASM3G7KrYiIiIj0n0N6nXKr3IqIiIgMKrFy2i Zpp1NulVsRERGRwSQtp/t2OuVWuY3nfRVms1V473qdiIiIyAEZTrl9vQvT67uQDKCwHqXcHlLgdhXDySRMNmar98jls5BeX Hv7U0e5FRERkR5yvnL7ehemuZK1Ng8vaalVbtvdN1mGZbL9ISwns7B6fw rWa7QJsswma3C /b63O2zO582yq2IiIj0kPOW26byOqpy x5Ws9Joac3I6vtqlpX92Sq8x 5bm7TUlsrttjwmYTlZhmidjW3P yrMZsuwzK1/dxdOwrIygjwLqyQrsJV9rKwnX8BFRERE9k 53E4qg6uZ1uX2P373l1BWW15jI7eFUd6r8PAav8/DbbZxi f1dcn9VW6jN/d9vQvT63lYXKe3/RIerov3q13n612Yxrah08htqWSm172vwix3ebLc/LvtyGZlHdWymCw3lxVaatP2lEaA68pxeTsmy5CEXMlu2sfSet5Xs02xFxERETkssZHbXcV2d7l9 0soaz8t4SksJvPw0jSiu1nWtpg z8MkVpyf52Fy 1QsqM/zrLxu79ewzmOU29K817VlSLaFtFQgW5Xb4pSDZJmOsm5GfstDrskyK7l121NZb3laQ33S0dnCCO 529Li0j X1lAqwiIiIyL6pm5bQVGz3L7dtRm7rSnDTFIbaUd/JuryWry//u806O01LCNVy21hWSwWw1e1j0xC2Ky9OUyjcL1Zi65bTvtym5blabiP7qNyKiIjIiVJXbtOCu6v Tnabc7pp7W1duy6OsdVMeYuV2z/m jeV2W9jWxa4yf/V9FZZZQy2 pd84V7ZcOEvLT //vgqz/EpLo6mx7SmUzu0H05r2LV1/OhJdnZZQ2cekuJ731aw60iwiIiKyR5rKbZtOV1Nu/xrK2s 5fQqL/JSDruU2d3lyf9Vu5LZpnftOSwjZfNfqB8omuW8ziH94rHDfXAofztr5gbXih9OaviJs 0GvytSJSJqKezpPtzItYdexEBERETk8Ayy3NVMLWk5LeMl9yGx6O283ctu0zgPK7cXFV3SJiIjI hed85XaPt/wvgXIrIiIiMpwot8qtiIiIyGii3Cq3IiIiIqNJ2s/2odwqtyIiIiKDys3NzUGU28fH3rcBAIDj dDlVkRERETGnQ9VbgEAGJezl9tvnz7Dxev7iQsAxB2l3PZdNGCo9v3EJwCwn87ltu yAGNw6KdBAYCq1iO3x3pB73uYuuzx8THc3PgqMOmeYxZdERERWeeQXnfUctt3SVVuZahRcEVERN onVk7bJO10e5XbvgupcitjiIIrIiJSTVpO9 10ncpt30VUuZUxRrkVERHJotxeSrl9X4XZbBXeT7 mfhPbz2Pte vlvIfVbBImyyS7KFmG/I8Hr6/uumQZJpNZWHXYWeVWREQky3jK7etdmF7fhaTPcvu CrPJJEwKuhWV2tSVvtL6lknNbU V8rreV2FW2OckLCfL0LoXDqDcvq9mWbFNy ZqGZar9fGetT2h 5TbdJ0d9le5FRERyaLcHrvcnqpUtil9vYzuFsvr 2oWZrNZNsrZdZt6L7dJWFb INmM5Hbdhn3L7WZ9bUeKlVsREZEs5XI7qQw8Zg4vt693Ybpd4FV4eK2WxeT KrfS7DaFyysl9kt4uM42dHr/FB6uJ2HxnF7/FBaTq/DwfBem1/OwyN12e5u6bXu9C9OabW1fbpOwzI/4FUY319dVRl7LI79tSl yXI84ppdv/rtalpYfNqOTNetY334ZkkrJihW/EJJldlmyXIYkWWb7mv93Yb82hbi8zvw paOmySrMZsuwnEVGw2PL3LGuwrLLJ6s8atpq5Lbm/CbZ grHe3tuavZpc/u2I8TKrYiISJbYyO2uYruz3P7n219D2bdPn8NiMg8vXUZan dhcvu0KZjZfV9uc8upW15638pyckX1eR4mk3l4eXuq37au5bZ88NKi9L4Ks21hTItMbISu9DZ qag2T0soFeHN9dvl173dnS/Fk9L2pNeV/13YjLSIvYfVchXeQxKWm/Uky3R56wJYKNexdRa2PVdKc XvfTXb7EfNMpvWVV527b5Uj1HjSGrs/NasL1luSnx0nyLHfUeUWxERkSx10xKaiu3e5XZaac01JTV/m u7kLw9hUXd7WvLclZYX243I7TR22xGdNts24HTEtLRu8IIX4t5tJURzfxtY9MS6gpx/ufyeuoKdK5sZ0W1smNhlpbH9dBzWM3SohcZNd2uP7Jf2 2KFPxW991xeXnZkXPUek5t5L7x85uOzrfYp7rrG6LcioiIZKkrt2nB3dXp4uX2938NZd8 fd49UlseJY2W0YZSXFr utTmRmWbyu2e83U7zblNlu3KbWwZrW67KaK7ym35Q19No8MhLbVNHwzbXJcb3XxfLcPqPRvB7VR QZ6uQ5D/UdcxyW1525TDvX253n99cyd1Vbo3cioiI7JWmctum03Uqt4v8HNcWo6/J/dV65Pb1Lizuv4Rsfm1kmkBp6kJ FHia3jc2dSE3MhzdtqPMuQ0hGwHNz1utm5YQGSFtO e2zcht6fLtW JNxXrHtwQky/UHybY3SZZhNssXxR1TBSL7lCw364xtb9P0gxbr2i67uiPtPjhWmdoQOb 5473M/pJYT1tI6vYp 9mcWxERke45a7mNTzkoLvjlNvfBsNv5poymI7bpB8a RDcqve 0rgiX11 eZxvbtkPn3E5m6xHM8tzXwnzSpg UNUwZqKyvNAVgR3FM7zdbLhtHbreFrKFrVeaMxubv7vqQV XnzQe1lsvq8WhaZqt1lT4Etk38Q3ORHc6V25rzW5mWMMlGdmPnuHC8fVuCiIjIPjlvud3jbf DbEdm66cuHOpD/B/KOn7v6qWnPIp69vieWxERkb0z6nK7/SCZcntQaj9INtpE/g9l54r/Q5mIiMhBGXW5PYePUG5l2FFuRUREsqT9bB/KrXIrA4hyKyIikuXm5uYgNeX2x1A25nLb9zbwseXLbd/bAgBj8KHLrUjfMXIrIiJy2nyocgt9M3ILAMfVutx6AYbjyD fPLcA4Lg6l1svzNBOm eN5w8AHNfRyu2j4A0JbnAAAMX6tym7/DKYsufBR9P/EBYKw6l9s6fZcFGJq n9wA8BEdrdzuq 8CAm30/UQFANrpvdwCAMCxKLcAAIyGcgsAwGgotwAAjIZyCwDAaCi3AACMRqXcfv39j6Hs5Bvyehem13ch GcABuQhtj9eu26XXdz3 zhdjVPe49ngHuChHLLdfwsP1JEzavgjkXzB6ffHouN1D2L6hlFsv uy0efxOqqb3X86/HW2eD20vb8NzBODsjlduX /C9HoeFtdX4eG17e0HUG67bvcQtm8o5bbvY8NlGfrzXLkFGIVquf3Dj6GszYKS 6swvf8SXm5zIzLlX zbn4ujOdPbeZhe34WH2 yyxXPuPtvRnnl4yS1nffv1Zcn9VTYqlC/Nk bSWr/d87C4Trcl297Fc4v1p ss3K5pv q3sc32Fe5fWG75WMS3L2nYzqb9Sgr/bTheA3igH9dvw48/ xy /exX4Ye3r H7t1 Hnz59Dt8 /TL8Of9z7fUfVKToRR9fDY/joz7PG9ZTe3mbbd8q/Z67/9J5f3s/ZwAX6Ejl9kt4SEdEnufFF4i6t9PL/84Xoe0ynsKiXLRun6q3f70L07T4vn0NL7e5Etz4otew3ZPc5ZPSbcrrL3uex7ezsF/Z9taP7rTYvvS4RI5Xttya9eX/G93Ohv2q3L/heA3ggX5cyu1edo1ipo vusfxsZ/njc X2OUN 7bd9g77vGt/ z5fABfqOOW28Mv4KSzKI3yx2zVNS6h7uzx9cav88l /OEzyBa6NNtsd 3fsxSc28tK0X5U5iJFt73JcY8dl1/qajnPTCFZ05LbFeR2NcrktK5dbqo/n3GVtnzenfJ7nb9f0fNi17bv2udP DuCcAVygo5Tb4lttuQ LnK3cprq9 LXa7jbltjxytOtFsuWLV6fjuqvcNr3wNpbihv0aULn98y8 h2 fUuUR0k0ZTa8vlM6siP6YW8ZPv6m//z / 3Wp3ObLbmxdsTJ86DZdoLbPm/KI/4F/zHb /dSmbNZte9M 772/AHRxhHK7nldWeIu 8PZ99gKUvX3 tTiVYMdITXRaQun2i 08utxbkDvermzc7q7lNvfzdj9b7tdex7W8vu3bmy2mK5S3p WLfGW/BlFuSyWxUnBrrq9MGeh4/0 HlNtDt lCtX3elB7H cfjUZ/njc X2OX1 xK9TXq7mt9zO/e37/MFcKEOL7fRX8TZL v8qEn6wbH0ti 38cvr3xavKcPbkZzSVwzteNGr3e7n7tMSXnIfxtruT9e3 9se1 eG z7P48e7zfSCyLob92sI5fY3v1wXv1/8envZD9/9PHz7xa/CD0n8 nSUdz0SmhbJn4cfk68hK56bn5NfhX WR1Yrl9XMwa27/tBtGsAvjr20fd6UHsfZY/zIz/PXr/XPl7rL22x7ze3SD7S1398BnDOAC3S0b0uAPvzw3c8b37KPXr8pl//87rchNj92XTQ3RXJz2 g0hT3L7cHbNIDjflZ1H9Yaq4 2vwBHptxy2WpGbtclMX59dJS0rkj2OXL7gcttfoSz8wfILtBH21 AU1JuuXBHmnNbWyS7zrmNLXPPObcfuNwCwL6UW0agXBb3 7aE iLZ5dsSYsvc/9sSlFsA6Ea5BQBgNCLl9m hrO NBACANpRbAABGQ7kFAGA0lFsAAEZDuQUAYDSUWwAARkO5BQBgNJRbAABGQ7kFAGA0lFsAAEajUm 7/6w9/C2V9byQAALSh3AIAMBrKLQAAo6HcAgAwGtVy 8e/hbK NxIAANpQbgEAGA3lFgCA0VBuAQAYDeUWAIDRUG4BABgN5RYAgNFQbgEAGA3lFgCA0VBuAQAYDeX 2xB4fHzsJIfS zQAAl0q5PbHHx8dwc3PTSnpC t5mAIBLpdyeWFpu2yQ9IX1vc9TrXZhe34XkoywPALhIyu2JHa3cvt6F6WQSJhvT y8n2N4v4eE6W0fe9HY zDKaLke5BQDelNuTO1a5XUyuwsNr vNTWNw nXbby2Vx6COtyi0A8BYtt38PZX1v5CU7Xrmdh5fI5cn9VW6EdVOAX /CtHD7p z hRHgfGEuqSm3D7fZaO7iuf5265HUeVhcp7fNRoWz 2XXF7Y9tp6mfTVyCwBsKLcndqxy 5KWvaYR2 f59vqX26wUZpc/FUtyUyGMldZJaZmxUpkvm2kBfZ5nZTR/v1y5Tu6vcpdH1lO3r8otAJCj3J7Y0T9Q9jwvltzSXNxtESwU3fyIbnk bXxEeOe0hLpSGbs89u9oeZ6Hl6b1xvZVuQUAcpTbEzvNtyVsRmBLo5/FAvolPFzPw8vbU1jESuYuQyu3dfuq3AIAOcrtiR2r3E7z0xFqCt32rf3cz4vbee6bFZ7CIv Wf5Mu5TY3 luYXtCh3Cb3V8VpBm33VbkFAHIq5fa///j3UNb3Rl6yY5Xb4ld0ZSOYL7cNX9dV WDZ1/ppDGVty 1b8YNe221oU25j29Gwnui KrcAQI5ye2KPj4 dT0jf2wwAcKmU2zMf4LYjuAAAdKfcAgAwGsotAACjUS233/89lPW9kQAA0IZyCwDAaCi3AACMhnILAMBoKLcAAIyGcgsAwGgotwAAjIZyCwDAaCi3AACMhnILA MBoKLcAAIyGcgsAwGgotwAAjIZyCwDAaCi3AACMhnILACPyL//2r3RwynPx7dNnOjjWcVduAeBC9V0Mx2rf89F3ORybfc DcgsAF6Tv4vfR7DoffRfAj6LLc0S5BYALcaoRx49un N6ypHHj pYx7RSbv/n 3 Esr53FgA OmW232OdP97K7Hnse5yVWwAYOKV2OMddqT2/rsdcuQWAAVNsh3X8ldr KLcAMAKKbf9ixVa57Ueb46/cAsCAKbf9M2o7HMotAFy4unIrp8vNzU30HDQVKzld8udDuQWAC9dUbvvetjF6fHzcu9z2ve1jVD 4f 5XbP/0jlPW9YwDwUSm356XcDotyCwAjo9yel3I7LMotAIyMcnteyu2wnKzcnjLlBxAAkFFuz0u5HZaLG 7mNPYAAgIxye17K7bAotwAwMsrteSm3w6LcAkBXr3dhen0Xkr63o8agy 3zPEwmk415eOl7e47gcsrtl/BwPcmO/1kfw09hMbkKD6/nPx/KLQAjVXphz5nef m2LOV2P693YZovtK934eG5/ N1qIsot693YTqZhMVz8bLzHX/lttMDCAA6ObScKrf7eZ6febTwPIZfbtd/2C16/UNiTOX2yL8AlFsADhZ7bdqMbFXeLo9dnrt/cn/V09u89QZbbt ewqJmpPzlNjeafvsUooUsX47rzlcPBl9uyyPmEdXjn56vq/BwP695l6P4bsj2XEXPjXLb6QEEAJ1UXpvWpSt9cU7urzYv8DWXp/cvlYaX2 OVrNj0ibb3HW65/RryhSg kpgrQc/zXNFaF7D1fUpF6XnefWrJEV1EuW3dxfLHdv34356D53murK7PY/W4150b5bbTAwgAOim/NsV nszDy87LNy/ Jxo53KfYfv829HKbP5a5glv4oFm XOVG/qKjtuXRxvO7iHK76zFae/zzhTT3c90ya8/NCMptYceiD8bcwbm Cw 32S Hprd4lFsADna0cpsu83Qlt2ux/f7tQsrtW2kkvDAimJWg5P4qTO /bP9bOA8D2Ifv3y6g3O6ac1t7/Pctt7FzM4JyW5h3sf3rtjSHafuWTnmeRv1bPMotAAc74rSExfZt2WIp69Ngy 3zXe745N7WrsylzR3H17swvZ6HxXW D9TP3e3D8Mvt1 3IbPTbEmqPf0O5bZyW0GK6whnPx9HKbeWv4dgw9R5//Sq3ABzsaB8oS1 z9vxKsRMZbLktHa9sKkHug0nX87Ao/JGwua487aDcK0xL2K18zLbPgbrj31Ruq cz/oGyEU1LiJbb2Nzb2jm58ZKr3AJAs GW23G6mHL7QZys3Obnykxyf91W5ntE5jM1vcWj3AJAM X2vJTbYTlKuf3fP/0jlG3formdZ U1NhxeOy0h/haPcgsAzZTb81Juh Vk5facDyAAIKPcnpdyOyzKLQCMjHJ7XsrtsCi3ADAyyu15KbfDotwCwMgot el3A7LkcrtT6Hs8fHxZJRbAKjXVG5P fr8ke1bbvve7rE6Sbm9ubk5qb5/cQDAUNWV21O/Nn90sXPQVKz63t6xS4/z0cpt309sAPio8uW2XHA57/FvU6w4rf3K7f/9FMr63hEA MjKBVfJ7eeYK7f9U24BYCRiZUvJPe9xVm77p9wCwIjUFS/F9zzHUbntn3ILACPUtZyxn/JxV277d7RyKyIiIsNM3wVwbJqSL1bfPn0 0xmWNPsef VWRERkROm7LA7NoVFw 8khx125FREREWlIuWgpuadL7FgrtyIiIiJHzjFKl9Sn7vjuc4yVWxEREZEWaSpgiu/unOv4KbciIiIiHdK1pHHePwqUWxEREZE903cRHItjRrkVEREROUH6LoxDcs4otyIiIiIymii3Ii IiIjKaKLciIiIiMpootyIiIiIymvw/oi5 ozJ9RfYAAAAASUVORK5CYII=
thank you in advance for your support,
Amrane