Re: appending data to ms access table using ms excel

Tech-Archive recommends: Fix windows errors by optimizing your registry

From: Myrna Larson (anonymous_at_discussions.microsoft.com)
Date: 09/02/04 

Date: Wed, 01 Sep 2004 21:43:21 -0500

Here's a routine that I use to append daily stock price information to the MDB
file where I keep historical quotes. I have a generic function that sets up
the connection, rather than doing that in the sub itself.

Prices() is a module level array, defined with a Type/End Type block.

  Private Sub WritePricesToMDBFile()
    Dim cnn As ADODB.Connection
    Dim FieldNames As Variant
    Dim rst As ADODB.Recordset
    Dim SQLOpen As String
    Dim SQLTicker As String
    Dim Stk As Long
    Dim ThisTicker As String
    Dim ThisDate As Date
    Dim ThisPrice As Double
    
    '08/23/2004: Prices table in ClosePrices.mdb is now linked to
    'MutFunds.mdb, so don't have to update two databases
    
    FieldNames = Array("PrTicker", "PrDate", "PrNAV")
    ThisDate = Prices(0).TradeDate 'Prices() is module-level
    SQLTicker = "PrTicker = 'TTTT'"
    
    'open connection to the file -- function is in Personal.xls
    Set cnn = OpenConnection("ClosePrices.MDB")
    
    'create recordset
    Set rst = New ADODB.Recordset
    
    With rst
      .ActiveConnection = cnn
      
  ' immediate & batch update modes use different settings for
  ' CursorType, CursorLocation and LockType
  
  ' 'Immediate update mode:
  ' .CursorType = adOpenKeyset
  ' .CursorLocation = adUseServer
  ' .LockType = adLockOptimistic
  
  ' Batch update mode:
      .CursorType = adOpenStatic
      .CursorLocation = adUseClient
      .LockType = adLockBatchOptimistic
      
      'open it, retrieving records for ThisDate only
      SQLOpen = "SELECT * FROM Prices WHERE PrDate = " & SQLDate(ThisDate)
      .Open Source:=SQLOpen, Options:=adCmdText
    
      If .RecordCount = 0 Then
        'there are no records for this date;
        'add new record for each ticker
        For Stk = LBound(Prices) To UBound(Prices)
          .AddNew FieldNames, _
             Array(Prices(Stk).Ticker, ThisDate, Round(Prices(Stk).Last, 3))
          .Update
        Next Stk
        
      Else
        'file already has *some* prices for this date, but possibly not all
        'if record exists for this ticker, update it; if not, add one
        For Stk = LBound(Prices) To UBound(Prices)
          ThisTicker = Prices(Stk).Ticker
          ThisPrice = Round(Prices(Stk).Last, 3)
          
          .MoveFirst
          .Find Replace(SQLTicker, "TTTT", ThisTicker)
          If .EOF Then
            'no price for this ticker
            .AddNew FieldNames, Array(ThisTicker, ThisDate, ThisPrice)
          Else
            'update existing price
            !PrNAV = ThisPrice
          End If
          .Update
        Next Stk
      End If
      .UpdateBatch
      
    End With 'rst
       
    Set rst = Nothing
    cnn.Close
    Set cnn = Nothing
    
  End Sub 'WritePricesToMDBFile
  
  Function OpenConnection(dBaseName As String) As ADODB.Connection
    Dim Cnxn As ADODB.Connection
    Set Cnxn = New ADODB.Connection
    
    With Cnxn
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .ConnectionString = "Data Source = " & XLDocDir & dBaseName
      .Open
    End With
    
    Set OpenConnection = Cnxn
    Set Cnxn = Nothing
  End Function
  

On Wed, 1 Sep 2004 19:15:48 -0700, "MA" <anonymous@discussions.microsoft.com>
wrote:

>Help, I am trying to update an Access table that has one
>field with a value that is coming from an Excel table. I
>looked through several cites are I have been
>unsuccessful. I believe that ADO would be needed to
>accomplish the task. If anyone has a short example of the
>code that would be needed in Excel to control access
>please let me know. Thanks in advance

Quantcast