PDA

View Full Version : Solved: Export a sheet as file



ronjon65
11-06-2011, 07:32 PM
I have looked as some codes, but not do quite what I want. I want to essentially copy a sheet to a new file, but with the following criteria:

- A typical "windows" box comes up that allows the user to enter the new file name. By typical "windows" box, it would look like the save as dialog box.
- A default directory is used (lower priority).

Thanks for any help!

GTO
11-06-2011, 10:46 PM
Greetings and welcome to vbaexpress!

Maybe something like:

Option Explicit

Sub example()
Dim wbNew As Workbook
Dim FileName As String

'// Change to suit or leave out /
Const FileNameDefault As String = "C:\Forms\2011-11-06\MyNewWB.xls"

FileName = Application.GetSaveAsFilename(InitialFileName:=FileNameDefault, _
FileFilter:="Excel Workbook (*.xls), *.xls", _
Title:="Save As")
'// Bail if user cancels//
If Not FileName = "False" Then
'// If file already exists... /
If Len(Dir(FileName)) Then
'// ...as if want to replace//
If MsgBox("File already exists. Do you want to replace?", _
vbQuestion Or vbYesNo, "???" _
) = vbYes Then

Set wbNew = SaveSheet(ThisWorkbook, "Sheet1")
'// Kill alerts just long enough to overwrite file //
Application.DisplayAlerts = False
wbNew.SaveAs FileName:=FileName, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
Else
Exit Sub
End If
Else
Set wbNew = SaveSheet(ThisWorkbook, "Sheet1")
wbNew.SaveAs FileName:=FileName, FileFormat:=xlWorkbookNormal

End If

wbNew.Close False
End If
End Sub

Function SaveSheet(wb As Workbook, SheetName As String) As Workbook
Dim wbNew As Workbook

'// add a new one-sheet wb //
Set wbNew = Workbooks.Add(xlWBATWorksheet)
'// copy sheet of interest to it //
wb.Worksheets(SheetName).Copy After:=wbNew.Worksheets(1)
Application.DisplayAlerts = False
'// get rid of blank sheet in new wb //
wbNew.Worksheets(1).Delete
Application.DisplayAlerts = True
'// Set a reference to the new wb and return it //
Set SaveSheet = wbNew
End Function

ronjon65
11-06-2011, 11:15 PM
Very nice, works great for me :)

I need it to do a couple more things. How can I rename the newly created single sheet? Otherwise, when I read it back in to the original file, it will have a sheet name conflict.

Second, what would be the code to read the single sheet back into a worksheet? I suppose it would look similar, but use read in commands rather than save as.

ronjon65
11-07-2011, 04:01 PM
Is there a better way to detect if the file already exists than using the "Len" command?

As it stands, it is quite easy for the code to misinterpret whether or not the file exists.

mdmackillop
11-07-2011, 04:54 PM
The Dir checks for the existence. The Len function just makes the returned value easier to handle.

ronjon65
11-07-2011, 06:21 PM
Thanks, I stand corrected. I did not do a proper test.

That said, any idea what the code would be to read the created file back into another file? The approach would be the same (i.e. windows dialog box and select the file).

GTO
11-07-2011, 09:08 PM
...I need it to do a couple more things. How can I rename the newly created single sheet? Otherwise, when I read it back in to the original file, it will have a sheet name conflict.

Second, what would be the code to read the single sheet back into a worksheet? I suppose it would look similar, but use read in commands rather than save as.


Thanks, I stand corrected. I did not do a proper test.

That said, any idea what the code would be to read the created file back into another file? The approach would be the same (i.e. windows dialog box and select the file).

If by "...read it back into the original file,..." you mean copy the sheet back to ThisWorkbook - have you tried modifying the code I gave you? Basically it is the same operation. For instance, if you add:


'// Copy the sheet back to ThisWorkbook
wbNew.Worksheets(1).Copy ThisWorkbook.Worksheets(1)


...right before wbNew.Close, the sheet will be copied back from the new workbook and the copy will by leftmost in the original. The sheet having the same name as a sheet in the destination wb is not an issue, as Excel will alter the name of the incoming sheet. You may rename the sheet in either wb, but I would first ensure that the name desired does not exist in the affected wb.

Mark

ronjon65
11-07-2011, 09:20 PM
Sorry, I was not clear. I want to rename the exported sheet such that it has a different sheet name than its original name.

Then, at a later date, I want to read the file back in. If it is renamed upon exporting, then I won't have a conflict later.

GTO
11-07-2011, 11:44 PM
No problem - using the current code, you could just add the lines in red:

Sub example()
Dim wbNew As Workbook
Dim FileName As String

'// Change to suit or leave out /
Const FileNameDefault As String = "C:\Documents and Settings\MARK\Desktop\DURANGO Forms\2011-11-06\MyNewWB.xls"

FileName = Application.GetSaveAsFilename(InitialFileName:=FileNameDefault, _
FileFilter:="Excel Workbook (*.xls), *.xls", _
Title:="Save As")
'// Bail if user cancels//
If Not FileName = "False" Then
'// If file already exists... /
If Len(Dir(FileName)) Then
'// ...as if want to replace//
If MsgBox("File already exists. Do you want to replace?", _
vbQuestion Or vbYesNo, "???" _
) = vbYes Then

Set wbNew = SaveSheet(ThisWorkbook, "Sheet1")

wbNew.Worksheets(1).Name = "Test name"
'// Kill alerts just long enough to overwrite file //
Application.DisplayAlerts = False
wbNew.SaveAs FileName:=FileName, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
Else
Exit Sub
End If
Else
Set wbNew = SaveSheet(ThisWorkbook, "Sheet1")
wbNew.Worksheets(1).Name = "Test name"
wbNew.SaveAs FileName:=FileName, FileFormat:=xlWorkbookNormal

End If

wbNew.Close False
End If
End Sub

ronjon65
11-08-2011, 10:24 AM
GTO,

Looks good, thanks again :)

Now I just need the code to read the newly created file into another workbook. It should have the same windows box for "open file"

mdmackillop
11-10-2011, 06:26 AM
To minimise browsing, you could save the original & new book paths and sheet names in a text file, and select from that limited list if you want to copy back to the original file.

ronjon65
11-10-2011, 08:20 AM
Thanks, that is not a bad idea as well.

But I first need to the code to read the single sheet back into a file. Once I have that last piece, then I will start playing around with the fine tuning.

GTO
11-10-2011, 10:53 AM
Thanks, that is not a bad idea as well.

But I first need to the code to read the single sheet back into a file. Once I have that last piece, then I will start playing around with the fine tuning.

Not sure what year Excel you are using, if after 2000, you may wish to also look at FilePicker (which I cannot recall the exact name). Currently, you would want to look up GetOpenFilename and GetSaveAsFilename in vba Help.

Option Explicit

Sub exampleImport()
Dim wbImport As Workbook
Dim FileName As String

Const InitialFolder As String = "C:\Documents and Settings\MARK\Desktop\Forms\2011-11-06\"

ChDrive "C"
ChDir InitialFolder
FileName = Application.GetOpenFilename(FileFilter:="Excel Workbook (*.xls), *.xls", _
Title:="Import File", _
MultiSelect:=False)


'// Bail if user cancels or attempts to reopen thisworkbook//
If Not FileName = "False" _
And Not FileName = ThisWorkbook.FullName Then

Set wbImport = Workbooks.Open(FileName, False, True)
With wbImport
.Worksheets(1).Copy ThisWorkbook.Worksheets(1)
.Close False
End With
End If
End Sub

Happy coding!

Mark

ronjon65
11-13-2011, 09:54 PM
GTO,

Thanks again. That is working fine in 2003. I will have to test it on other platforms though.