Solved

VBA Create / delete spreadsheet via function

Posted on 2013-12-24
6
512 Views
Last Modified: 2014-01-09
I'm finishing up an app in Access 2010  and wish to generate results within a spreadsheet created on the fly.   I've worked with doing this in VBA before, but mostly the code was specific for a certain spreadsheet. A sub for this sheet, a sub for that.  And all subs created the sheet, filled in information and then closed them.

This time I would like to modularize it as much as possible. I'm trying to create a sub that I could call with a name and it would create a spreadsheet and allow me to edit it.  The code in each main sheet would look like this:

MySheet = CreateSheet("C:\MySheets\NewSheet")

With mySheet
     .Range("A7").Select
    .ActiveCell.FormulaR1C1 = sClientName & " - A really important sheet"
   .......etc
end with

CloseSheet(Mysheet)


I usually start with this in my create:
===============================================
sub ThisRoutine(sSheetName as string)
'this is the beginning of my standard sheet creation in EVERY Sheet SUB
Dim objXL As Object
Dim strWhat As String, boolXL As Boolean
Dim objActiveWkb As Object
Dim sAnswer As String
If FileExists(sSheetName & ".xls") Then
    sAnswer = MsgBox("File already exists. Do you wish to overwrite?", vbYesNoCancel)
    Select Case sAnswer
    Case vbNo
        iTemp = 1
        sSheetName = sSheetName & "_" & Trim(str(iTemp))
        Do While FileExists(sFullFileName & ".xls")
            iTemp = iTemp + 1
            sSheetName = Mid(sSheetName, 1, Len(sSheetName) - Len(Trim(str(iTemp - 1)))) & "_" & Trim(str(iTemp))
        Loop
    Case vbCancel
        GoTo EXIT_ThisRoutine
    End Select
End If

If fIsAppRunning("Excel") Then
    Set objXL = GetObject(, "Excel.Application")
    boolXL = False
Else
    Set objXL = CreateObject("Excel.Application")
    boolXL = True
End If

objXL.Application.Workbooks.Add

Set objActiveWkb = objXL.Application.ActiveWorkbook
..........etc
===============================================

What's the best way to make this a CreateSheet routine and make sure everything is opened and closed properly?

Can I create a CloseSheet function likewise?


J
0
Comment
Question by:GNOVAK
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
6 Comments
 
LVL 30

Expert Comment

by:hnasr
ID: 39738559
Upload what you have now, with test data.
What you want is: (modify if different)
Pass a name (x.xls) to sub to create xls document, issue necessary editing, then close file.x,xls.
0
 
LVL 14

Accepted Solution

by:
Zack Barresse earned 500 total points
ID: 39738614
Hi there,

Usually this is best done within a single routine. The problem is ensuring you have the same file throughout your code. You could set it as a variable and pass it to a routine if you'd like however.

A function to get an Excel object could look something like this...

Function GetXL() As Object
    If GetXL Is Nothing Then
        Set GetXL = GetObject(, "Excel.Application")
        If GetXL Is Nothing Then
            Set GetXL = CreateObject("Excel.Application")
        End If
    End If
End Function

Open in new window


If you're looking at compartmentalizing this, however, I'd think about making a class for it. If you open Excel when it wasn't already open, generally it's best to close it when you're done, and likewise if it's already open when you start running your code it's best to leave it open. Basically leaving the application in the state it was prior to your code running. Generally this is done in-line with another variable, but if you're using other subs or functions to create these objects you'll either need a public variable (I use them sparingly) or a class.

Getting a workbook is relatively simple once you get the application...

Function CreateBook(ByRef ExcelApp As Object) As Object
    Set CreateBook = ExcelApp.Workbooks.Add(-4167)
End Function

Open in new window


That just creates a new workbook with a single sheet. To actually open a file I'd use something a little different. This is one option...

Function GetBook(ByRef ExcelApp As Object, _
                 ByVal NameOfFile As String, _
                 Optional ByVal PathOfFile As String, _
                 Optional ByVal ForceOpen As Boolean = True, _
                 Optional ByVal ForceUpdates As Boolean = False) As Object
    If ISWBOPEN(NameOfFile, ExcelApp) = True Then
        Set GetBook = ExcelApp.Workbooks(NameOfFile)
    Else
        If Dir(PathOfFile & IIf(Right(PathOfFile, 1) = "\", "", "\") & NameOfFile, vbNormal) <> vbNullString Then
            If ForceOpen = True Then
                Set GetBook = ExcelApp.Workbooks.Open(PathOfFile & IIf(Right(PathOfFile, 1) = "\", "", "\") & NameOfFile, ForceUpdates)
            End If
        End If
    End If
End Function

Function ISWBOPEN(ByVal wkbName As String, ByVal XLAPP As Object) As Boolean
    On Error Resume Next
    ISWBOPEN = CBool(Len(XLAPP.Workbooks(wkbName).Name) <> 0)
    On Error GoTo 0
End Function

Open in new window


Closing a book should be a fairly simple sub routine...

Sub CloseBook(ByRef ExcelFileToClose As Object, _
              Optional ByVal SaveBeforeClose As Boolean = True)
    On Error Resume Next
    ExcelFileToClose.Close SaveChanges:=SaveBeforeClose
    On Error GoTo 0
End Sub

Open in new window


These then become fairly modular and you can use the variables set from an outside procedure. Here is an example of using these...

Sub foo()
    Dim XL                      As Object
    Dim MyFile                  As Object
    Dim MySheet                 As Object
    Set XL = GetXL()
    If XL Is Nothing Then
        MsgBox "Couldn't find Excel.", vbExclamation, "Whoops!"
        Exit Sub
    End If
'    Set MyFile = CreateBook(XL)
    Set MyFile = GetBook(XL, "Book1.xlsx", "C:\Users\Zack\Desktop", True, False)
    Set MySheet = MyFile.Worksheets(1)
    Call CloseBook(MyFile, True)
End Sub

Open in new window


I'm not sure if this is what you're looking for or not.

HTH

Regards,
Zack Barresse
0
 

Author Closing Comment

by:GNOVAK
ID: 39752326
Thanks so much - - prefect!
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 14

Expert Comment

by:Zack Barresse
ID: 39752555
You're very welcome. :)

Zack
0
 

Author Comment

by:GNOVAK
ID: 39763135
Is there a way to set the directory where the workbook is created?  I'll have the workbook automatically created for the user. I need to check their directory and if its not there, create it using the above Create.  But it doesnt seem to accept the destination.
0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 39769000
You can use the Dir() function to see if a file or folder exists. If you wanted it in a function you could use something like below. It's just one way to do it. Basically it's a function that returns a number based on what you want done. Pass the folder and if you want to force it created or not. Check the return to see what happened...

-1: Insufficient rights to create folder
0: User had choice to create and did not
1: Folder already exists
2: Folder created

Option Explicit

Sub Test()
Debug.Print GetFolder("C:\Users\Zack\Desktop\Test", False)
End Sub

Function GetFolder(ByVal FolderPath As String, Optional ByVal ForceCreate As Boolean = False) As Long
    Dim UserCreate              As Boolean
    Dim msgCreate               As VbMsgBoxResult
    '/// Check if folder exists
    If Dir(FolderPath, vbDirectory) = vbNullString Then
        '/// Force folder creation
        '/// Folder doesn't exist
        '/// Ask user if they want it created
        If ForceCreate = False Then
            msgCreate = MsgBox("Folder doesn't exist. Create it now?", vbYesNo, "Create folder?")
        End If
        UserCreate = ForceCreate = False And msgCreate = vbYes
        If UserCreate = True Or ForceCreate = True Then
            On Error Resume Next
            MkDir FolderPath
            On Error GoTo 0
            '/// Check if folder was created
            If Dir(FolderPath, vbDirectory) = vbNullString Then
                '/// Folder wasn't created
                'MsgBox "Folder not created. Check permissions.", vbExclamation, "ERROR!"
                'Exit Function
                GetFolder = -1
            Else
                'MsgBox "Folder created successfully!", vbInformation, "Success!"
                'Exit Function
                GetFolder = 2
            End If
        Else
            '/// Folder doesn't exist, user doesn't want to create it
            GetFolder = 0
        End If
    Else
        '/// Folder exists
        GetFolder = 1
    End If
End Function

Open in new window


This is just one option to have it in a function.

HTH

Zack
0

Featured Post

SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question