Solved

VBA Create / delete spreadsheet via function

Posted on 2013-12-24
6
486 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
  • 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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

708 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now