Option Explicit

Public Const DataLocation As String = "C:\Documents and Settings\Alice\Desktop\Database\TestDatabase21.accdb" Sub Market_Update() Call ImportFromAccessTable(DataLocation, "Final_Table", Worksheets(2).Range("A5")) End Sub

Sub ImportFromAccessTable(DBFullName As String, TableName As String, TargetRange As Range)

Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer

Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
    ' open the recordset
    ' .Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
    
    ' all records
    .Open "SELECT * FROM Final_Table", cn, , , adCmdText
    ' filter records
    
    For intColIndex = 0 To rs.Fields.count - 1 ' the field names
        TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
    Next
    TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data

End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

End Sub

Sub Company_Information()

Dim companyName As String

On Error GoTo gotoError companyName = Application.InputBox(Prompt:="Enter Company Name", _ Title:="Company Name", Type:=2)

Exit Sub 'Don't execute errorhandler at end of routine

gotoError: MsgBox "An error has occurred" End Sub

The code for this part can be seen following:

Sub UPDATE()

Dim cnt As ADODB.Connection Dim stSQL As String, stCon As String, DataLocation As String Dim stSQL2 As String

'database path - currently same as this workbook DataLocation = ThisWorkbook.Path & DataLocation stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & DataLocation & ";" 'SQL code for GL Insert to Access stSQL = "INSERT INTO Historical_Stock_Data SELECT * FROM [Portfolio] IN '" _ & ThisWorkbook.FullName & "' 'Excel 8.0;'"

'set connection variable Set cnt = New ADODB.Connection 'open connection to Access db and run the SQL With cnt .Open stCon .CursorLocation = adUseServer .Execute (stSQL) End With 'close connection cnt.Close

'release object from memory Set cnt = Nothing

End Sub

I get the following error with this.

Run-time Error '-2147467259 (80004005)'

The Microsoft Jet database engine cannot open the file 'Cocuments and Settings\Alice\Desktop\Database'. It is already opened exclusively by another user or you need permission to view its data.

Option Explicit

Public Const DataLocation As String = "C:\Documents and Settings\Alice\Desktop\Database\TestDatabase21.accdb"

Sub Market_Update()
    Call ImportFromAccessTable(DataLocation, "Final_Table", Worksheets(2).Range("A5"))
End Sub

Sub ImportFromAccessTable(DBFullName As String, TableName As String, TargetRange As Range)

    Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
    
    Set TargetRange = TargetRange.Cells(1, 1)
    ' open the database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & DBFullName & ";"
    Set rs = New ADODB.Recordset
    With rs
        ' open the recordset
        ' .Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
        
        ' all records
        .Open "SELECT * FROM Final_Table", cn, , , adCmdText
        ' filter records
        
        For intColIndex = 0 To rs.Fields.count - 1 ' the field names
            TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
        Next
        TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data

    End With
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Sub Company_Information()

   Dim companyName As String
   
On Error GoTo gotoError

   companyName = Application.InputBox(Prompt:="Enter Company Name", _
                           Title:="Company Name", Type:=2)                  
        
    Exit Sub 'Don't execute errorhandler at end of routine

gotoError:
    MsgBox "An error has occurred"

End Sub

The code for this part can be seen following:

Sub UPDATE()

   Dim cnt As ADODB.Connection
   Dim stSQL As String, stCon As String, DataLocation As String
   Dim stSQL2 As String

   'database path - currently same as this workbook
   DataLocation = ThisWorkbook.Path & DataLocation
   stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
   "Data Source=" & DataLocation & ";"
   'SQL code for GL Insert to Access
   stSQL = "INSERT INTO Historical_Stock_Data SELECT * FROM [Portfolio] IN '" _
   & ThisWorkbook.FullName & "' 'Excel 8.0;'"
   
   'set connection variable
   Set cnt = New ADODB.Connection
   'open connection to Access db and run the SQL
   With cnt
        .Open stCon
        .CursorLocation = adUseServer
        .Execute (stSQL)
   End With
   'close connection
   cnt.Close

   'release object from memory
   Set cnt = Nothing

End Sub

I get the following error with this.

Run-time Error '-2147467259 (80004005)'

The Microsoft Jet database engine cannot open the file 'Cocuments and Settings\Alice\Desktop\Database'. It is already opened exclusively by another user or you need permission to view its data.