Problem with Closeing Excel after it is called with VBA in Access 2010.

Rick48 · October 16th, 2013, 01:40 PM

I am not a programmer but I have been trying to learn how to do some automation using VBA in Access 2010. I have a database that I am using to track my IRA and have some code that use's excel to go out to Yahoo Finance to get stock info. This works but it will only run once, because it leaves the excel process open and I have to go into VBA editor and hit the reset button to get it to run again. I'll attach the Function I have written below. If anyone could tell me what I need to change to get excel to terminate properly I would appreciate the help.

Thank you

Code:

Function OpenCloseExcel(AstrSql)

    Dim Parameters As String
    Dim Symbol As String
    Dim qurl As String
    Dim MyPath As String
    Dim I As Integer
    Dim QuerySheet As Worksheet
    Dim ExcelWorkBook   As Workbook
  
   Dim ExcelApp As Object
   
   On Error GoTo ErrorTrap

   Set ExcelApp = CreateObject("Excel.Application")
   Set ExcelWorkBook = ExcelApp.Workbooks.Add
   
   'MsgBox "open"
'*************************************************************
    ExcelApp.Visible = False
    
    'Set newWkSheet = newWbk.Worksheets(1)
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    
    I = 0
    qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=" + AstrSql(I)
    I = I + 1
    While AstrSql(I) <> ""
        qurl = qurl + "+" + AstrSql(I)
        I = I + 1
    Wend
    
    Parameters = "snl1ohgrs7a2vx"
    
    'Parameters List
    '   s = symbol
    '   n = Name
    '   l1 = Last Trade (Price Only)
    '   o = Open
    '   h = days high
    '   g = days low
    '   r = P/E Ratio
    '   s7 = Short Ratio
    '   a2 = Average daily volume
    '   v = Volume
    '   x = stock exchange
    
    
    qurl = qurl + "&f=" + Parameters
    
    MyPath = "C:\Temp\" & "StockData" & ".Xlsx"
    Range("A1").CurrentRegion.ClearContents
    
     
QueryQuote:
            With Excel.ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=ActiveSheet.Range("A2"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With
            
            Range("A2").CurrentRegion.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
            TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, other:=False
            
            
            
            Range(Range("A2"), Range("A1").End(xlDown)).NumberFormat = "0.00"
            Range(Range("B2"), Range("B2").End(xlDown)).NumberFormat = "0.00"
            Range(Range("C2"), Range("C2").End(xlDown)).NumberFormat = "0.00"
            Range(Range("D2"), Range("D2").End(xlDown)).NumberFormat = "0.00"
            Range(Range("E2"), Range("E2").End(xlDown)).NumberFormat = "0.00"
            Range(Range("F2"), Range("F2").End(xlDown)).NumberFormat = "0.00"
            Range(Range("G2"), Range("G2").End(xlDown)).NumberFormat = "0.00"
            Range(Range("H2"), Range("H2").End(xlDown)).NumberFormat = "0.00"
            Range(Range("I2"), Range("I2").End(xlDown)).NumberFormat = "0,000.00"
            Range(Range("J2"), Range("J2").End(xlDown)).NumberFormat = "0,000.00"
            Range(Range("K2"), Range("K2").End(xlDown)).NumberFormat = "0.00"
            ActiveSheet.Range("A1").Value = "Symbol"
            ActiveSheet.Range("B1").Value = "Name"
            ActiveSheet.Range("C1").Value = "Last Trade price"
            ActiveSheet.Range("D1").Value = "Open"
            ActiveSheet.Range("E1").Value = "Days High"
            ActiveSheet.Range("F1").Value = "Days Low"
            ActiveSheet.Range("G1").Value = "P/E Ratio"
            ActiveSheet.Range("H1").Value = "Short Ratio"
            ActiveSheet.Range("I1").Value = "Average Daily Volume"
            ActiveSheet.Range("J1").Value = "Volume"
            ActiveSheet.Range("K1").Value = "Stock Exchange"
            
    Columns("A:A").EntireColumn.AutoFit
    Excel.Application.Calculation = xlCalcultaionAutomatic
    
    ExcelApp.Workbooks(1).SaveAs MyPath
       Excel.Application.DisplayAlerts = True

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "StockData", MyPath, True
  
'*************************************************************
   ExcelWorkBook.Close
   Set ExcelWorkBook = Nothing
   ExcelApp.Quit 'this line terminates the process
   Set ExcelApp = Nothing
   MsgBox "Done"
   Exit Function

ErrorTrap:
   Debug.Print "(" & Err.Number & ") " & Err.Description
End Function

ETruss · March 25th, 2014, 04:09 PM

Try the answers given here:

http://social.msdn.microsoft.com/For...-excel-problem

Basically, you may be doing something that leaves an object unclosed and when you set the ExcelApp to Nothing, Excel does not go away. Since you declared ExcelWorkBook also, you must set it to Nothing also.

Maybe try something like:

'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "StockData", MyPath, True

'************************************************* ************
Debug.Print ExcelWorkBook.Name
If Not (ExcelWorkBook Is Nothing) Then
ExcelWorkBook.Close
Set ExcelWorkBook = Nothing
End If

If Not (ExcelApp Is Nothing) Then
ExcelApp.Quit 'this line terminates the process
Set ExcelApp = Nothing
End If
MsgBox "Done"
Exit function

ErrorTrap:
Debug.Print "(" & Err.Number & ") " & Err.Description
If Not (ExcelWorkBook Is Nothing) Then
ExcelWorkBook.Close
Set ExcelWorkBook = Nothing
End If

If Not (ExcelApp Is Nothing) Then
ExcelApp.Quit 'this line terminates the process
Set ExcelApp = Nothing
End If