Saving a new file using the same filepath

XLS Padlock
1

I’ve been struggling with this for a long time and wondered if anyone else has come up with a solution? Basically I am trying to save a new file using VBA but want it to be saved in the same file as the original exe file. In a standard Excel file the following code works: -
Dim Fnme As String
With ThisWorkbook
Fnme = Left(.FullName, InStr(.FullName, “.”) - 1) & _
"_" & Format(Now, “dd mmm yyyy_hh_mm_ss”) & " SUBMISSION" & ".xlsx"
End With

At one stage I think the following worked in an XLSPadlock protected file but it no longer does: -
With ThisWorkbook
Dim Fnme as String
Set XLSPadlock = Application.COMAddIns(“GXLSForm.GXLSFormula”).Object
PathToFile = XLSPadlock.PLEvalVar(“EXEPath”) & Filename
Fnme = Left(.PathToFile, InStr(.PathToFile, “.”) - 1) & _
"_" & Format(Now, “dd mmm yyyy_hh_mm_ss”) & " SUBMISSION" & ".xlsx"
End With

Has anyone managed to get something similar to work? Any help would be much appreciated.

2

What does happen? Is your code posted here complete because we don’t see what you do once you have Fnme?

3

Hi

Below is the full code which is contained within a UserForm – I have highlighted where I’ve tried to update the code to still work with XLS Padlock: -

Private Sub cmdExport_Click()

Dim i As Integer, sht As String

Application.ScreenUpdating = False

Application.EnableEvents = False

'save current view of visible worksheets

Dim CCnt As Byte

Dim Ckst As Worksheet

Dim CArr() As String

Dim Ckbk As Workbook

Dim Cnme As String



'Construct array containing

'names of current visible worksheets

'in this workbook

CCnt = 0

For Each Ckst In ThisWorkbook.Worksheets

    If Ckst.Visible Then

        CCnt = CCnt + 1

        ReDim Preserve CArr(1 To CCnt)

        CArr(CCnt) = Ckst.Name

    End If

Next Ckst

'hide all the current visible sheets initially

Dim wsht As Object



For Each wsht In ThisWorkbook.Worksheets

If wsht.Name <> "Details" Then

wsht.Visible = False

End If

Next wsht

'Show list of all worksheets avaialble to export

For i = 0 To lstVisible.ListCount - 1

'select the required sheets

If lstVisible.Selected(i) = True Then

sht = lstVisible.List(i)

'hide the unselected sheets

Sheets(sht).Visible = True

End If

Next i

Unload Me

'Prepare only visible worksheets for export

Dim WCnt As Byte

Dim Wkst As Worksheet

Dim WArr() As String

Dim Wkbk As Workbook

Dim Fnme As String

Dim shp As Shape

'Hide Sheets That Are Not To Be Included

 Sheets("Payment Breakdown").Visible = False

 Sheets("Summary").Visible = False

'Construct array containing

'names of visible worksheets

'in this workbook

WCnt = 0

For Each Wkst In ThisWorkbook.Worksheets

    If Wkst.Visible Then

        WCnt = WCnt + 1

        ReDim Preserve WArr(1 To WCnt)

        WArr(WCnt) = Wkst.Name

    End If

Next Wkst



'Copy visible worksheets

'to new workbook

ThisWorkbook.Worksheets(WArr).Copy

Set Wkbk = ActiveWorkbook

    

'Copy and paste values

'for each worksheet

'in new workbook

For Each Wkst In Wkbk.Worksheets

    Wkst.Unprotect ("aaa")

    

    With Wkst.Cells

        .Copy

        .PasteSpecial (xlPasteValues)

    End With

    'With Wkst

   Application.CutCopyMode = False

    Range("a1").Select

            

    For Each shp In Wkst.Shapes

        shp.Delete

        Next shp

  

    With Wkst.Cells.Validation

    .Delete

    End With

    

 Application.CutCopyMode = False

    Range("a1").Select

    ActiveCell.Offset(1, 1).Select

    ActiveCell.Offset(-1, -1).Select

    

    Wkst.Protect ("aaa")

Next Wkst



'Construct file name

'for new workbook

With ThisWorkbook

    Fnme = Left(.FullName, InStr(.FullName, ".") - 1) & _

        "_" & Format(Now, "dd mmm yyyy_hh_mm_ss") & " SUBMISSION" & ".xlsx"

End With



'XLS FileName Function

'With ThisWorkbook

'Set xlspadlock = Application.COMAddIns("GXLSForm.GXLSFormula").Object

'Dim PathtoFile As String

'Filename = xlspadlock.PLEvalVAR("EXEPath") & Filename

'    Fnme = Left(.PathtoFile, InStr(.PathtoFile, ".") - 1) & _

 '       "_" & Format(Now, "dd mmm yyyy_hh_mm_ss") & " SUBMISSION" & ".xlsx"

'End With





'Save and close

'new workbook

With Wkbk

    

    .SaveAs _

        Filename:=Fnme, _

        FileFormat:=xlOpenXMLWorkbook

     .Close

End With

'Activate this workbook

ThisWorkbook.Activate



'Notification that

'new workbook was created

MsgBox _

    Prompt:="New workbook created:" & vbCrLf & Fnme, _

    Buttons:=vbInformation

Application.EnableEvents = True

'Unhide Worksheets

For Each wsht In ThisWorkbook.Worksheets

If wsht.Name <> "Details" Then

wsht.Visible = False

End If

Next wsht

For Each Ckst In ThisWorkbook.Worksheets(CArr)

Ckst.Visible = True

Next Ckst

End Sub

I look forward to hearing from you.

Regards

Vince

4

Is it normal that these lines are commented?

image

5

Hi

Are you referring to any lines in particular or all of those that are commented – it is a bit hard to follow your post as the code seems to have been split up into sections and some parts are grey and other white?

What I sent you in my Email works in a standard excel set-up. The parts highlighted in yellow are one of my attempts to get the code to work once the sheet has been protected with XLS Padlock – this code replaces what is directly above it. I left both sets of code there so you can see what I am trying to achieve.

Please let me know if you require any further information.

Regards

Vince

6

In the code you posted here;

these lines are commented so not working?

7

Hi

Those are the lines that I have tried to use to get the protected file to create a new workbook in the same folder as the original file – but they didn’t work. I left them there so you could see what I had tried.

The code that is uncommented works in an unprotected workbook perfectly – so this is what I am trying to replicate. However, at present the code creates an new workbook in a virtual file and is therefore of no use.

I hope that explains everything.

Regards

Vince

8

Vince,

The XLS Padlock Function “PathToFile” is a replacement for Excel’s VBA equivalent of “ThisWorkbook.Path”. When compiled, the compiled workbook version does not parse the “ThisWorkbook.Path” statement and that is why you need to use the XLS "“PathToFile” function. In your example your file name is defined OK with your code:

Dim Fnme As String
With ThisWorkbook
Fnme = Left(.FullName, InStr(.FullName, “.”) - 1) & _
"_" & Format(Now, “dd mmm yyyy_hh_mm_ss”) & " SUBMISSION" & ".xlsx"
End With

You do not need to try to integrate defining the file name into the function code as you have tried. Once you have your file name, you can simply use another XLS Padlock Function named "SaveSecureWorkbookToFile " to simply save to a secure workbook with your file name as follows:

ChDir PathToFile("") 'if needed, use this to make certain user is in workbook startup location
SaveSecureWorkbookToFile (Fnme)

You should have a separate module with all of the XLS Padlocks functions in it. This way you can experiment with different methods of saving and getting file names.

9

Your intial error was in your filepath definition.

Try
Public Function SetSecureWorkbookFilename(Filename As String)
Dim XLSPadlock As Object
On Error GoTo Err
Set XLSPadlock = Application.COMAddIns(“GXLS.GXLSPLock”).Object
XLSPadlock.SetDefaultSaveFilename (Filename)

SetSecureWorkbookFilename = "OK"
Exit Function

Err:
SetSecureWorkbookFilename = ""
End Function

Sub Save_new_File
’NOTE this will save a secure version not a xlsx

Dim Filepath As String
Dim Fnme as string

'Set file path
Dim XLSPadlock As Object
Set XLSPadlock = Application.COMAddIns(“GXLSForm.GXLSFormula”).Object
Filepath = XLSPadlock.PLEvalVar(“EXEPath”)

'set File Name
Fnme = Fnme = Left(.FullName, InStr(.FullName, “.”) - 1) & _

“_” & Format(Now, “dd mmm yyyy_hh_mm_ss”) & " SUBMISSION" & ".xlsx"
Fnme = Filepath & myFile
SetSecureWorkbookFilename (Fnme)
ActiveWorkbook.Save
End Sub

ActiveWorkbook.Save