Saving user data to 2nd workbook

I have tried the below code and I cannot get it to work. I am using Excel 2019. I have tried on my project but also on a new spreadsheet with default configurations, sheet names and cell references as written in your original sample macro and I get the same vba 400 error.

When I run the macro below from a button as instructed it creates a new workbook called “Sheet1” with one worksheet called “Sheet1” then in this new workbook displays a VBA 400 error.

If I try and step through the macro in the vba editor in the actual spread sheet I get a 1004 error after line 4 - activesheet.name

Please help? My whole project hinges on users being able to export their data to a file and then re-import this data into a newly compiled .exe saved file.

Regards
Simon

Sub GenerateData()
Dim strFile As String
'New workbook with 3 sheets
Workbooks.Add xlWBATWorksheet
ActiveSheet.Name = “SheetA”
Sheets.Add(After:=Sheets(1)).Name = “SheetB”
Sheets.Add(After:=Sheets(2)).Name = “SheetC”
ActiveWorkbook.Sheets(“SheetA”).Range(“A1:C3”).Value = ThisWorkbook.Sheets(“SheetA”).Range(“A1:C3”).Value
ActiveWorkbook.Sheets(“SheetB”).Range(“B3”).Value = ThisWorkbook.Sheets(“SheetB”).Range(“B3”).Value
ActiveWorkbook.Sheets(“SheetC”).Range(“B1:C3”).Value = ThisWorkbook.Sheets(“SheetC”).Range(“B1:C3”).Value
strFile = Application.GetSaveAsFilename("", “Excel workbook (.xlsx),.xlsx”, 1)
If strFile <> “False” Then ActiveWorkbook.SaveAs strFile, FileFormat:=51
ActiveWorkbook.Close False
End Sub

See the manual section 11.8 about saving to other workbooks.
You are missing crucial code.

Try this:

Dim DestinationWorkbook As Workbook
Dim SourceWorkbook As Workbook

'Add the string file here or in the strFile = Application.GetSaveAsFilename("", “Excel workbook (.xlsx),.xlsx”, 1)
'If strFile <> “False” Then ActiveWorkbook.SaveAs strFile, FileFormat:=51

strFile = " ???
strFile = Filepath & “Export\Repair” & strFile

Set SourceWorkbook = ActiveWorkbook

Workbooks.Add

 

Set DestinationWorkbook = ActiveWorkbook

Set XLSPadlock = Application.COMAddIns(“GXLS.GXLSPLock”).Object
XLSPadlock.SetOption Option:=“2”, value:=“0”
XLSPadlock.SetOption Option:=“1”, value:=“1”
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strFile, ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
XLSPadlock.SetOption Option:=“2”, value:=“1” 'resets default save behaviour
XLSPadlock.SetOption Option:=“1”, value:=“0”
'Create worksheet tabs

        Worksheets.Add
        ActiveSheet.Name = "Sheet A"
        Worksheets.Add
        ActiveSheet.Name = "Sheet B"
        Worksheets.Add

DestinationWorkbook.Worksheets(“About”).Range(“A1:C3”).value = _
SourceWorkbook.Worksheets(“About”).Range(“A1:C3”).value
DestinationWorkbook.Worksheets(“About”).Range(“C5:C6”).value = _
SourceWorkbook.Worksheets(“About”).Range(“C5:C6”).value
'Do other copy codes here

'resaves data
Set XLSPadlock = Application.COMAddIns(“GXLS.GXLSPLock”).Object
XLSPadlock.SetOption Option:=“2”, value:=“0”
XLSPadlock.SetOption Option:=“1”, value:=“1”
DestinationWorkbook.Close savechanges:=True
XLSPadlock.SetOption Option:=“2”, value:=“1” 'resets default save behaviour
XLSPadlock.SetOption Option:=“1”, value:=“0”

My vba knowledge is limited and I don’t know where to insert the crucial missing code. For example I don’t exactly know what you mean by “Add the string file here” Where & what is the string file?

Also I wanted to use it with “do not allow loading or saving of other workbooks” but this seems to add even another level of complexity. Also what about the restriction “Do not allow other instances of Excel when opening the protected work book” Is additional code also required for this option to be active?

I created a dummy workbook called originaldata.xlsm and included 3 sheets as labelled in the below code examples that I tried to run. SheetA, SheetB, SheetC.

Then I just put some text in the cell ranges and then I compiled the .exe.

Then I opened the originaldata.exe and saved a user file test.xlsc.

Then I opened the .exe again loading the last saved file and then tried to run the Sub Generatedata() and this is when I got the VBA 400 error.

So here is the code as I understood it but I don’t know where or how exactly to add the crucial missing code you documented above.

Sub GenerateData()
Dim strFile As String
'New workbook with 3 sheets
Workbooks.Add xlWBATWorksheet
ActiveSheet.Name = “Sheet1”
Sheets.Add(After:=Sheets(1)).Name = “SheetB”
Sheets.Add(After:=Sheets(2)).Name = “SheetC”
ActiveWorkbook.Sheets(“SheetA”).Range(“A1:C3”).Value = ThisWorkbook.Sheets(“SheetA”).Range(“A1:C3”).Value
ActiveWorkbook.Sheets(“SheetB”).Range(“B3”).Value = ThisWorkbook.Sheets(“SheetB”).Range(“B3”).Value
ActiveWorkbook.Sheets(“SheetC”).Range(“B1:C3”).Value = ThisWorkbook.Sheets(“SheetC”).Range(“B1:C3”).Value
strFile = Application.GetSaveAsFilename("", “Excel workbook (.xlsx),.xlsx”, 1)
If strFile <> “False” Then ActiveWorkbook.SaveAs strFile, FileFormat:=51
ActiveWorkbook.Close False
End Sub

Sub TheTransfer()
Call Open_Workbook_Dialog
Call TransferData
End Sub

Sub Open_Workbook_Dialog()
Dim my_FileName As Variant
my_FileName = Application.GetOpenFilename( _
FileFilter:=“Excel Files,.xl;.xm”, _
FilterIndex:=3, _
Title:=“Select the old version of your file, where you will pull the data from”, _
MultiSelect:=False)
If my_FileName <> False Then
Workbooks.Open Filename:=my_FileName
End If
End Sub

Sub TransferData()
If Workbooks.Count > 1 Then
Workbooks(1).Sheets(“SheetA”).Range(“A1:A3”).Value = Workbooks(2).Sheets(“SheetX”).Range(“A1:A3”).Value
Workbooks(1).Sheets(“SheetB”).Range(“A1:A3”).Value = Workbooks(2).Sheets(“SheetY”).Range(“A1:A3”).Value
Workbooks(1).Sheets(“SheetC”).Range(“A1:A3”).Value = Workbooks(2).Sheets(“SheetZ”).Range(“A1:A3”).Value
Workbooks(2).Close savechanges:=False
Else
MsgBox “The data hasn’t been transferred.”, vbExclamation, “Error”
End If
End Sub

The string is if you wanted to set a saved file name and pathway by default. This is instead of asking them to save a filename. I just realised you need the filepathcode as well

You need to have '“Do not allow loading or saving of other workbooks” unticked.

Also as a tip for debugging when I generate an exe allow “Show Developer Tab” . This is not the final version I release to customers but it enables you to open the exe file, open the VBA editor and then select the troublesome procedure and either run using F8 or just run as normal but you can view what line is generating the error.

I haven’t used the xlWBATWorksheet before.
Workbooks.Add is simpler and works just fine

Try this code. (It was adapted from my code. Some dims might not be used.

Private Sub EXPORT()
'Based on Upgrade 3
’ Macro to import data during upgrade

'Dim DestinationFile As String
Dim SourceFile As String
Dim Filepath As String
Dim strFile As String

Dim DestinationFilepath As String
Dim count As Integer
Dim wb As Workbook

Dim DestinationWorkbook As Workbook
Dim SourceWorkbook As Workbook

Dim intChoice As Integer
Dim Ret

'No need to set as set as public
'Dim DestinationWorkbook As Workbook
'Dim SourceWorkbook As Workbook

Application.DisplayAlerts = True
'Check Security Access

'Set file path
Set SourceWorkbook = Application.ActiveWorkbook

Dim XLSPadlock As Object
Set XLSPadlock = Application.COMAddIns("GXLSForm.GXLSFormula").Object
Filepath = XLSPadlock.PLEvalVar("EXEPath")


'Test if Directory exists
If Dir(Filepath & "Export\", vbDirectory) = "" Then
   MkDir Filepath & "Export\"
End If

'Set file name of destination workbook
strFile = " Export Data " & " Exp " _
& Format(Now(), “dd mm yy hh mm”)

strFile = Filepath & “Export” & strFile

Workbooks.Add
  

Set DestinationWorkbook = ActiveWorkbook

Set XLSPadlock = Application.COMAddIns(“GXLS.GXLSPLock”).Object
XLSPadlock.SetOption Option:=“2”, value:=“0”
XLSPadlock.SetOption Option:=“1”, value:=“1”
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strFile, ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
XLSPadlock.SetOption Option:=“2”, value:=“1” 'resets default save behaviour
XLSPadlock.SetOption Option:=“1”, value:=“0”
'Create worksheet tabs

        Worksheets.Add
        ActiveSheet.Name = "SheetA"
        Worksheets.Add
        ActiveSheet.Name = "SheetB"
        Worksheets.Add
        ActiveSheet.Name = "SheetC"

SourceWorkbook.Activate

Application.ScreenUpdating = True

 Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'Application.DisplayAlerts = False


DestinationWorkbook.Worksheets("SheetA").Range("A1:C3").value = _
SourceWorkbook.Worksheets("SheetA").Range("A1:C3").value

DestinationWorkbook.Worksheets("SheetB").Range("B3").value = _
SourceWorkbook.Worksheets("SheetB").Range("B3").value

DestinationWorkbook.Worksheets("SheetC").Range("B1:C3").value = _
SourceWorkbook.Worksheets("SheetC").Range("B1:C3").value



    Set XLSPadlock = Application.COMAddIns("GXLS.GXLSPLock").Object
    XLSPadlock.SetOption Option:="2", value:="0"
    XLSPadlock.SetOption Option:="1", value:="1"
        DestinationWorkbook.Close savechanges:=True
    XLSPadlock.SetOption Option:="2", value:="1"    'resets default save behaviour
    XLSPadlock.SetOption Option:="1", value:="0"

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox “Export file completed.”

End Sub

Sub TransferData()

Dim SourceFile As String
Dim Filepath As String
Dim strFile As String

Dim DestinationFilepath As String
Dim count As Integer
Dim wb As Workbook
Dim DestinationWorkbook As Workbook
Dim SourceWorkbook As Workbook

Dim intChoice As Integer
Dim Ret

'Test if file is new
    Dim myFile As String
    myFile = GetSecureWorkbookFilename

'Set file path
Set DestinationWorkbook = Application.ActiveWorkbook

Dim XLSPadlock As Object
Set XLSPadlock = Application.COMAddIns("GXLSForm.GXLSFormula").Object
Filepath = XLSPadlock.PLEvalVar("EXEPath")
'Filepath = Application.ActiveWorkbook.Path


Filepath = Filepath & "Export\"

'only allow the user to select one file

'only allow the user to select one file
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = “Select File to be Upgraded. You will need to select the data file as well.”
.InitialFileName = Filepath
.Filters.Clear
.Filters.Add “Back Up Data file”, “*.xlsx”
End With

'make the file dialog visible to the user
    intChoice = Application.FileDialog(msoFileDialogOpen).Show

'determine what choice the user made
If intChoice <> 0 Then
    'get the file path selected by the user
    SourceFile = Application.FileDialog( _
        msoFileDialogOpen).SelectedItems(1)
    'MsgBox "File selected"
Else
    MsgBox "No File Selected - Import cancelled"
    Application.Run "Go_To_Main_Menu"
    Exit Sub
End If


Workbooks.Open SourceFile
'DestinationFilepath = Application.ActiveWorkbook.Path
Set SourceWorkbook = ActiveWorkbook

DestinationWorkbook.Worksheets("SheetA").Range("A1:C3").value = _
SourceWorkbook.Worksheets("SheetA").Range("A1:C3").value

DestinationWorkbook.Worksheets("SheetB").Range("B3").value = _
SourceWorkbook.Worksheets("SheetB").Range("B3").value

DestinationWorkbook.Worksheets("SheetC").Range("B1:C3").value = _
SourceWorkbook.Worksheets("SheetC").Range("B1:C3").value

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
'ActiveSheet.DisplayPageBreaks = True

Application.EnableEvents = True

End Sub

@ adworzak
Nice, I will try your macro later.

@ Trekkietracker
I created the macro you are trying to use. See my original post here with further explanation.

Hey ricdam… I tried your code and it did not work at all for me just a VB 400 error as soon as I start the export. Currently Anto is helping me with his code which seems to work better!

First, before going further, make sure that you disabled “do not allow loading or saving of other workbooks”.