VBAProjects remain in memory after workbook is closed
At a quick glance:
All this code is in a workbook ?
If so, there's no need for the variable created in "Set oExcel = GetObject(,
"Excel.Application")", as you already have the global Application object you
can use.
As, you are not setting this to Nothing (or it's not shown here anyway), it
would maintain a reference to Excel from your WB and prevent it from
unloading.
Change this and see if it helps.
NickHK
"Arif Ali" wrote in message
...
OK Guys, I give up. I hope you still have your notifications on for this
posting! I was hesitant to post my code in the fear that it would be too
messy (embarassing) or would require too much explanation. But at present
I'm
stumped. I'm obviously missing the point on this qualification issue so
here
goes. The general idea is that my "Quoter" workbook consists of:
1. A sheet called QuoteForm
2. A sheet called OrderEntry Form
3. Several Sheets with catalog items: part numbers, descriptions, prices;
one on each row
4. There is a navigation toolbar (userform) to move to different sheets
The user simply double clicks on the catalog items to be added to the
quote,
and they appear on the quote form and orderentry form. (For now this code
is
not included). When all items have been added, the user then saves the
quoteform and/or order entry forms to a separate workbook. There are
separate buttons that launch each of these options. We'll get to that
part a
little later.
Remember the problem is that each time I open and subsequently close a
workbook, the VBAProject says in memory. The only VBAProject that should
stay
in memory throughout the process is the main workbook that contains the
code
below.
Public QSPath As String
Public oExcel As Excel.Application
Public QS, Quoter, NewBook As Excel.Workbook
Public ParentSheet, FactorySuite, QuoteForm, OrderEntry, NewQuoteForm, _
NewOrderEntry As Excel.Worksheet
Private Sub Workbook_Open()
'first define and assign global variables
Dim QuoteSummaryExists As Boolean
Set oExcel = GetObject(, "Excel.Application")
Set Quoter = oExcel.ActiveWorkbook
Set QuoteForm = Quoter.Sheets("QuoteForm")
Set OrderEntry = Quoter.Sheets("OrderEntry")
Set FactorySuite = Quoter.Sheets("FactorySuite")
ThisWorkbook.Bookname = Quoter.Name ' Save name of activeworkbook
Set fs = CreateObject("Scripting.FileSystemObject")
homedrive = Environ("HOMEDRIVE") 'Capture Drive Letter
Homepath = Environ("HOMEPATH") 'Capture MyDocuments Path
Homepath = Homepath & "\My Documents\"
QSPath = homedrive & Homepath ' Set QuoteSumary Path
QuoteSummaryExists = fs.fileexists(QSPath & "QuoteSummary.xls")
'Check for existence of QuoteSummary
If Not QuoteSummaryExists Then
Call CreateQuoteSummary
End If
Quoter.Activate
QuoteForm.Activate 'Switch to Quoter Spreadsheet
If (QuoteForm.Range("b24").Value < "") Or (QuoteForm.Range("c15").Value
<
"") Or (QuoteForm.Range("M15").Value < "") Then
vbans = vbNo
vbans = MsgBox("Erase Existing Quote Information?", vbYesNo)
If vbans = vbYes Then
QuoteForm.Range("m17..r17").Value = CDate((Now()))
'Customer Name
QuoteForm.Range("C15..I15").Value = ""
' Name
QuoteForm.Range("C16..I16").Value = ""
'Address
QuoteForm.Range("C17..I17").Value = ""
'City
QuoteForm.Range("C18..E18").Value = ""
'State
QuoteForm.Range("g18").Value = ""
'zip
QuoteForm.Range("I18").Value = ""
'Quote Number
QuoteForm.Range("m15..r15").Value = ""
'Salesperson
' QuoteForm.Range("m16..r16").Value = ""
'Quote Date
' QuoteForm.Range("m17..r17").Value = ""
'QuoteBody
QuoteForm.Range("b24..r44").Value = ""
End If
End If
oExcel.ActiveWindow.ScrollRow = 1
QuoteForm.Range("A1").Value = ""
QuoteForm.Range("B24").Select
ActiveCell.Value = ""
'ActiveWorkbook.Sheets("FactorySuite").Activate
FactorySuite.Range("A1").Select
UserForm1.MultiPage1.Style = fmTabStyleTabs
UserForm1.Show 0
UserForm1.Left = 560
UserForm1.Top = 30
Set fs = Nothing
End Sub
If the quote summary does not exist, create it!
Private Sub CreateQuoteSummary()
Dim NewBook As Excel.Workbook
oExcel.ScreenUpdating = False
Set NewBook = oExcel.Workbooks.Add
NewBook.Activate
NewBook.Sheets("Sheet1").Activate
NewBook.Sheets("Sheet1").Range("A1").Value = "Salesman"
NewBook.Sheets("Sheet1").Range("B1").Value = "Quote Date"
NewBook.Sheets("Sheet1").Range("C1").Value = "Customer"
NewBook.Sheets("Sheet1").Range("D1").Value = "Quote Num"
NewBook.Sheets("Sheet1").Range("E1").Value = "Quote Amt"
NewBook.Sheets("Sheet1").Range("F1").Value = "FileName"
NewBook.Sheets("Sheet1").Range("a1").Select
NewBook.ActiveSheet.Name = "Quotes"
NewBook.SaveAs (QSPath & "QuoteSummary.xls")
NewBook.Close savechanges:=False
oExcel.ScreenUpdating = True
Set NewBook = Nothing
End Sub
From then on, as this spreadsheet gets populated in subsequent runs of the
tool, there is a button click event that calls the following routine.
This
routine opens the quote summary, populates a listbox and then closes the
spreadsheet.
Public Sub InitQuoteSummaryWindow()
oExcel.ScreenUpdating = False
Set QS = oExcel.Workbooks.Add(QSPath & "QuoteSummary.xls")
QS.Sheets("quotes").Activate
QS.ActiveSheet.Range("A1").Select
i = 0
Do While ActiveCell.Value < ""
i = i + 1
ActiveCell.Offset(1, 0).Select
Loop
frmQuoteSummary.ListBox1.Font.Name = "Arial"
frmQuoteSummary.ListBox1.Font.Size = 10
frmQuoteSummary.ListBox1.ColumnCount = 6
QS.Activate
frmQuoteSummary.ListBox1.ColumnHeads = False
frmQuoteSummary.ListBox1.RowSource = "a1:f" & CStr(i)
frmQuoteSummary.ListBox1.MultiSelect = fmMultiSelectSingle
frmQuoteSummary.ListBox1.ColumnWidths = "72;108;108;108;96;96"
frmQuoteSummary.ListBox1.TextAlign = fmTextAlignLeft
oExcel.ScreenUpdating = True
QS.Close
Set QS = Nothing
End Sub
Now lets look at how quotes and order entryforms are generated and saved.
Here is the button click event one for SaveNewOrderEntry. Note that this
event exists in a separate module and therefore includes the prefix
Thisworkbook. before the global variables like QuoteForm, etc. (I have
not
included the code for the two other varioations: SaveQuoteForm and
SaveBoth.
If we cant solve the issue looking at the code above, we can look at those
too.)
Private Sub btnSaveNewOE_Click()
Set ThisWorkbook.NewBook = ThisWorkbook.oExcel.Workbooks.Add
ThisWorkbook.OrderEntry.Copy
Befo=ThisWorkbook.NewBook.Sheets("Sheet1")
ThisWorkbook.NewBook.Activate
fname =
ThisWorkbook.oExcel.GetSaveAsFilename(InitialFileN ame:=(Range("c9").Value)
&
" " & Format(Now(), "mmddyy"))
If fname < False Then
If Right(fname, 1) = "." Then
fname = Left(fname, Len(fname) - 1)
End If
If Right(fname, 3) = "xls" Then
ThisWorkbook.NewBook.SaveAs Filename:=fname
Else
ThisWorkbook.NewBook.SaveAs Filename:=fname & ".xls"
End If
ThisWorkbook.NewBook.Close savechanges:=False
Else
ThisWorkbook.NewBook.Close savechanges:=False
End If
Set ThisWorkbook.NewBook = Nothing
End Sub
Thanks in advance!!!!
|