Export same table in the same workbook in diff worksheet

[a7n9]

Hi,

I'm running some simulations in Access using VBA and I create a table named "Results".

I've created "Export button" to export the Results table to the file selected by the user. However, I'm not able to export this table with a different name or change the worksheet name.

Here is the code I'm using, can someone please modify this so that, the results table will be exported to the worbook I select but with a different worksheet name every time.

Here's the code I got till now<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> cmdExport_Click()
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> errorhandler1
<SPAN style="color:#00007F">Dim</SPAN> strOPFilename <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> obj1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>
<SPAN style="color:#00007F">If</SPAN> fIsAppRunning("Excel") <SPAN style="color:#00007F">Then</SPAN>
  )  )  ) <SPAN style="color:#00007F">Set</SPAN> obj1 = GetObject(, "Excel.Application")
<SPAN style="color:#00007F">Else</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> obj1 = CreateObject("Excel.Application")
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
strOPFilename = obj1.GetSaveAsFilename(, "Excel files (*.xls), *.xls", , "Select the file name/location")
<SPAN style="color:#00007F">If</SPAN> strOPFilename = "" <SPAN style="color:#00007F">Or</SPAN> strOPFilename = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN>
    MsgBox "Not a valid filename, try again", vbCritical, Prog_TItle
    <SPAN style="color:#00007F">GoTo</SPAN> errorhandler1
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Results", strOPFilename

<SPAN style="color:#00007F">Set</SPAN> obj1 = <SPAN style="color:#00007F">Nothing</SPAN>
MsgBox "Results exported to " & strOPFilename & " succesfully!", vbInformation
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN> <SPAN style="color:#007F00">'if there is no error exit the sub</SPAN>
errorhandler1:
<SPAN style="color:#007F00">'If Err.Number = 2501 Then</SPAN>
<SPAN style="color:#007F00">'    MsgBox "Output location/file was not selected, Results were not exported", vbCritical, Prog_TItle</SPAN>
<SPAN style="color:#00007F">If</SPAN> Err.Number <> 0 <SPAN style="color:#00007F">Then</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> msg <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    msg = "Error # " & Str(Err.Number) & " was generated by " _
            & Err.Source & Chr(13) & Err.Description
    MsgBox msg, vbCritical, Prog_TItle & "-Error", Err.HelpFile, Err.HelpContext
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Set</SPAN> obj1 = <SPAN style="color:#00007F">Nothing</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>>

 

[Norie]

Could you please clean up the posted code?

 

[a7n9]

All right, I did it now.. HTML maker aptly puts "&nbsp" for a Tab but somehow it can't be seen on these pages. I replaced them with " "

 

[a7n9]

Anyone?

 

[Norie]

I see you have a reference to an instance of Excel.

Could you not use this to open the workbook and rename the exported sheet as required?

Private Sub cmdExport_Click()
On Error GoTo errorhandler1
Dim strOPFilename As Variant
Dim obj1 As Object
Dim wb As Object
Dim ws As Object

    If fIsAppRunning("Excel") Then
        Set obj1 = GetObject(, "Excel.Application")
    Else
        Set obj1 = CreateObject("Excel.Application")
    End If
    strOPFilename = obj1.GetSaveAsFilename(, "Excel files (*.xls), *.xls", , "Select the file name/location")
    If strOPFilename = "" Or strOPFilename = False Then
        MsgBox "Not a valid filename, try again", vbCritical, Prog_TItle
        GoTo errorhandler1
    End If
    
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Results", strOPFilename
    
    Set wb = obj1.Workbooks.Open(strOPFilename)
    
    Set ws = wb.Worksheets("Result")
    
    ws.Name = "NewSheetName"
    
    Set ws = Nothing
    Set wb = Nothing
    Set obj1 = Nothing
    
    MsgBox "Results exported to " & strOPFilename & " succesfully!", vbInformation
    
    Exit Sub
    
errorhandler1:
    If Err.Number <> 0 Then
        Dim msg As String
        msg = "Error # " & Str(Err.Number) & " was generated by " _
                & Err.Source & Chr(13) & Err.Description
        MsgBox msg, vbCritical, Prog_TItle & "-Error", Err.HelpFile, Err.HelpContext
    End If
    
    Set obj1 = Nothing
    
End Sub

 

[a7n9]

Thanks for your reply, Norie. Yes, I was trying to do similar kind of thing yesterday but it wasn't working, I'll try your suggestion.

Also, to rename the worksheet as unique, may be I can add a counter, so the new worksheet name would be newsheetname1, newsheetname2, etc.

Thanks. I'll try this and will let you know.

 

[a7n9]

Norie,

I tried it- it works fine for the first time, but second time it says "subscript out of range" because it overwirtes "Results" table on the worksheet we exported before this, which was renamed to NewSheetname.

I don't understand why it does that.

Private Sub cmdExport_Click()
counterwksht = counterwksht + 1
On Error GoTo errorhandler1
Dim strOPFilename As Variant
Dim obj1 As Object
Dim wb As Object
Dim ws As Object
If fIsAppRunning("Excel") Then
Set obj1 = GetObject(, "Excel.Application")
Else
Set obj1 = CreateObject("Excel.Application")
End If
strOPFilename = obj1.GetSaveAsFilename(, "Excel files (*.xls), *.xls", , "Select the file name/location")
If strOPFilename = "" Or strOPFilename = False Then
    MsgBox "Not a valid filename, try again", vbCritical, Prog_TItle
    GoTo errorhandler1
End If
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Results", strOPFilename
Set wb = obj1.Workbooks.Open(strOPFilename)
Set ws = wb.Worksheets("Results")
ws.Name = "sim" & counterwksht
wb.save
wb.Close
Set ws = Nothing
Set wb = Nothing
Set obj1 = Nothing
MsgBox "Results exported to " & strOPFilename & " succesfully!", vbInformation
Exit Sub 'if there is no error exit the sub
errorhandler1:
If Err.Number <> 0 Then
    Dim msg As String
    msg = "Error # " & Str(Err.Number) & " was generated by " _
            & Err.Source & Chr(13) & Err.Description
    MsgBox msg, vbCritical, Prog_TItle & "-Error", Err.HelpFile, Err.HelpContext
End If
Set ws = Nothing
Set wb = Nothing
Set obj1 = Nothing
End Sub

 

[Norie]

Sorry I don't understand what you mean.

Every time you run the Transferspreadsheet it should create a sheet called Results.

 

[a7n9]

No, it is not creating a new worksheet, it is just overwriting the "Results" worksheet even though we renamed it to something different.

 

[Norie]

Does the workbook you are exporting to already have a worksheet called Results?