View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
NickHK NickHK is offline
external usenet poster
 
Posts: 4,391
Default 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!!!!