Saving a copy of a protected workbook without a password

[scotthannaford1973]

Hi

I have an .xlsm file that is password protected through SaveAs-->General Options as the file is always opened read only without the password.

I want to apply a macro to a button that will export a copy either the current worksheet, or the entire workbook to a specific location of H:/

the coding I usually use works absolutely fine for copying the file, but the copy always asks for the password - so I want to tweak my code so a password is not needed on that copy.

TIA
---------------------------------------------------------------------

Sub Auto_Save()
Dim savedate

savedate = Date

Dim savetime
savetime = Time
Dim formattime As String
formattime = Format(savetime, "hh.MM")
Dim formatdate As String
formatdate = Format(savedate, "YYYY.MM.DD")

Application.DisplayAlerts = False

Dim backupfolder As String
backupfolder = "H:"
ActiveWorkbook.SaveCopyAs Filename:=backupfolder & formatdate & " " & formattime & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
MsgBox "CIP Tracker backed up to " & backupfolder & " - check folder if needed!"

End Sub

---------------------------------------------------------------------

 

[DanteAmor]

Try this

Change "abc" for the password of your workbook.

Sub Auto_Save()
  Dim formatdate As String, formattime As String, backupfolder As String
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
  formatdate = Format(Date, "YYYY.MM.DD")
  formattime = Format(Time, "hh.MM")
  backupfolder = "H:" & formatdate & " " & formattime & " " & ThisWorkbook.Name
  
  ActiveWorkbook.SaveCopyAs Filename:=backupfolder
  Workbooks.Open Filename:=backupfolder, Password:="[B][COLOR=#ff0000]abc[/COLOR][/B]"
  ActiveWorkbook.SaveAs Filename:=backupfolder, Password:=""
  ActiveWorkbook.Close
  Application.DisplayAlerts = True
  MsgBox "CIP Tracker backed up to " & backupfolder & " - check folder if needed!"
End Sub