excel to access data transfer

[xljdg]

I got this code and it is very useful for my project.

Sub ToAccess()
Dim axsApp As Object
'Assume Access already open with desired database
Set axsApp = GetObject(, "Access.Application")
Set cdb = axsApp.currentdb
Set rst = cdb.openrecordset("Employees")
Dim iRow As Long 'Excel worksheet row number
'Loop thru first 8 rows on active worksheet and put data from
'first two columns into Access employees table
For iRow = 1 To 8
With rst
.addnew
' read the names from Excel into Access table
!LastName = Cells(iRow, 2)
!FirstName = Cells(iRow, 1)
.Update
End With
Next iRow
End Sub

This code works only if the database is open can this work if the database is closed on the network.

any help will be greately appreciated.

 

[Case_Germany]

Hi and welcome,

the following code is from one of my projects:

Option Explicit
Const strPath As String = "C:\Temp\Nwind.mdb"
Dim blnTMP As Boolean
Public Sub Test()
    Dim rcsEntry As Object
    Dim objConn As Object
    Dim objApp As Object
    Dim lngRow As Long
    On Error GoTo Fin
    'Set objApp = OffApp("Word")
    'Set objApp = OffApp("Word", False)
    'Set objApp = OffApp("Outlook")
    'Set objApp = OffApp("Outlook", False)
    'Set objApp = OffApp("PowerPoint")
    'Set objApp = OffApp("PowerPoint, False")
    'Set objApp = OffApp("ACCESS")
    Set objApp = OffApp("ACCESS", False)
    If Not objApp Is Nothing Then
        Set rcsEntry = CreateObject("ADODB.Recordset")
        Set objConn = CreateObject("ADODB.Connection")
        With objConn
            .CursorLocation = 3 ' = adUseClient
            If Val(Application.Version) >= 12 Then
                .Provider = "Microsoft.ACE.OLEDB.12.0"
            Else
                .Provider = "Microsoft.Jet.OLEDB.4.0"
            End If
            .Properties("Data Source") = strPath
            .Open
        End With
        With rcsEntry
            .Open "Select * from Employees", objConn, 1, 3
            For lngRow = 1 To 8
                .AddNew
                !LastName = Cells(lngRow, 2)
                !FirstName = Cells(lngRow, 1)
                .Update
            Next lngRow
        End With
    Else
        MsgBox "Application not installed!"
    End If
Fin:
    If Not objApp Is Nothing Then
        If blnTMP = True Then
            objApp.Quit
            blnTMP = False
        End If
    End If
    Set objApp = Nothing
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String, _
    Optional blnVisible As Boolean = True) As Object
    Dim objApp As Object
    On Error Resume Next
    Set objApp = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objApp = CreateObject(strApp & ".Application")
            blnTMP = True
            If blnVisible = True Then
                On Error Resume Next
                objApp.Visible = True
                Err.Clear
            End If
    End Select
    On Error GoTo 0
    Set OffApp = objApp
    Set objApp = Nothing
End Function

You really only need...

With rcsEntry
    .Open "Select * from Employees", objConn, 1, 3
    For lngRow = 1 To 8
        .AddNew
        !LastName = Cells(lngRow, 2)
        !FirstName = Cells(lngRow, 1)
        .Update
    Next lngRow
End With

...with the appropriate adjustments.

 

[xljdg]

Thanks for your prompt reply.

i have modified my code

Sub Button1_Click()
'Sub ToAccess()
Dim axsApp As Object
'Assume Access already open with desired database
Set axsApp = GetObject(, "Access.Application")
Set cdb = axsApp.currentdb
Set rst = cdb.openrecordset("MPIhours")
Dim iRow As Long 'Excel worksheet row number
'Loop thru first 6 rows on active worksheet and put data from
'first two columns into Access employees table

With rst
.Open "Select * from MPIhours", objConn, 1, 3
For iRow = 1 To 6
.AddNew
' read the names from Excel into Access table
!TaskNo = Cells(iRow, 5)
!MPINo = Cells(iRow, 4)
!ProjectNo = Cells(iRow, 3)
!Hours = Cells(iRow, 2)
!Dicipline = Cells(iRow, 1)
.Update
Next iRow
End With
End Function


but the code breaks at

Set axsApp = GetObject(, "Access.Application")

There is no were i am telling the code what database to open . how can i modify this code. thank for all you help.

 

[Case_Germany]

Hi,

your code only works when Access is open and the database is loaded. When Access is closed and you want appeal to a specific database, you must modify the code as in my example. Look also at the following links:

CreateObject and GetObject Functions

How to use Access as an Automation Server

 

[xljdg]

Please help with this.
Office 2007 and access 2007
I have a database file
In C:\Tester\vptest.mdb"
Which has employees table.
Firstname
Lastname fields on it.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
I have a excel file with test data
Frank hastings
Luke brant
<o> </o>
I have a button in my excel sheet and assign the following code to it.
<o>
I want to be able to transfer the excel data into my database when it is closed.
</o>Option Explicit
Const strPath As String = "C:\Tester\vptest.mdb"
Dim blnTMP As Boolean
Public Sub Test()
Dim rcsEntry As Object
Dim objConn As Object
Dim objApp As Object
Dim lngRow As Long
On Error GoTo Fin
'Set objApp = OffApp("Word")
'Set objApp = OffApp("Word", False)
'Set objApp = OffApp("Outlook")
'Set objApp = OffApp("Outlook", False)
'Set objApp = OffApp("PowerPoint")
'Set objApp = OffApp("PowerPoint, False")
'Set objApp = OffApp("ACCESS")
Set objApp = OffApp("ACCESS", False)
If Not objApp Is Nothing Then
Set rcsEntry = CreateObject("ADODB.Recordset")
Set objConn = CreateObject("ADODB.Connection")
With objConn
.CursorLocation = 3 ' = adUseClient
If Val(Application.Version) >= 12 Then
.Provider = "Microsoft.ACE.OLEDB.12.0"
Else
.Provider = "Microsoft.Jet.OLEDB.4.0"
End If
.Properties("Data Source") = strPath
.Open
End With
With rcsEntry
.Open "Select * from Employees", objConn, 1, 3
For lngRow = 1 To 8
.AddNew
!LastName = Cells(lngRow, 2)
!FirstName = Cells(lngRow, 1)
.Update
Next lngRow
End With
Else
MsgBox "Application not installed!"
End If
Fin:
If Not objApp Is Nothing Then
If blnTMP = True Then
objApp.Quit
blnTMP = False
End If
End If
Set objApp = Nothing
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String, _
Optional blnVisible As Boolean = True) As Object
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, strApp & ".Application")
Select Case Err.Number
Case 429
Err.Clear
Set objApp = CreateObject(strApp & ".Application")
blnTMP = True
If blnVisible = True Then
On Error Resume Next
objApp.Visible = True
Err.Clear
End If
End Select
On Error GoTo 0
Set OffApp = objApp
Set objApp = Nothing
End Function
I want to transfer the names to the employee table in vptest database. My code gives me the error
Error number and file not found.
What am I doing wrong.
Should I check my library references.
Your help is greatly appreciated.
<o> </o>
<o> </o>

 

[Case_Germany]

Hi,

this code runs perfectly for me:

Excel - Access

In the zip file is an Excel file with the names and the sample database (nwind.mdb) from Microsoft.

Try it...

 

[xljdg]

Still not working.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
<o>Firstly , t</o>hank you for taking the time to attach a sample database.
<o> </o>The good part is I am not doing anything different.
The bad part is I am still unable to get this working.
I have you access file saved on my desktop
I have the excel file saved on the desktop as well.
The mdb file is closed while pressing the button to export the values from excel.
Testing
I added 2 employee names and clicked the button. The error prompt said it could not find the Nwind.mdb file.
Fehler:-error number could not find file ‘c:\Document and Settings\vprakash\Desktop\Nwind.mdb’
<o> </o>
I got the same error in my code as well, which makes me believe that the code works but I do not have the file name correctly.
This is what is have changed in the code
Option Explicit
Const strPath As String = "C:\Documents and Settings\vprakash\Desktop\Nwind.mdb"
Dim blnTMP As Boolean
Any help will be highly appreciated.

 

[xljdg]

Thank you for your support and direction. I just realised i was using mdb instead of accdb. i work with access 2007. Also the excel file and the database was in 2 different places.

it worked. thanks a ton.

 

[Case_Germany]

Hi,

it worked. thanks a ton.

 

[xljdg]

I am not sure if I should start a new thread. The code that you helped me with runs as long as the source and target db file are in the same folder. How do I modify it such that the code searches for the database target file on the network and saves the records.
With my limited vba knowledge this seems to be a mammoth task. Since the files are distributed over the network this is the only way I can go.
Any help will be highly appreciated.