Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

VB and Excel

marl24marl24 Member Posts: 20
Hello,

I need to store the data from excel to access database table. The excel would be my data entry form and store it in an access database. Can someone please help me

thanks in advance.


Comments

  • dokken2dokken2 Member Posts: 532
    see uploaded files-
    this example automates excel and uses dao to add the excel data to access

    [code]
    Option Explicit


    'VB6 MENU - PROJECT , REFERENCES, set a reference to:
    'Microsoft Excel 10.0 Object Library
    'Microsoft DAO 3.60 Object Library

    Const myExcel = "_Excel.xls" 'EXCEL FILE
    Const myAccess = "_Access.mdb" 'ACCESS FILE
    Dim myPath As String 'PATH (IN SAME FOLDER)

    Private mExcel As Excel.Application 'EXCEL


    Private Sub Form_Load()
    'INIT PROJECT PATH
    myPath = App.Path + ""
    End Sub


    Private Sub Command1_Click()
    ExcelToAccess
    End Sub




    Sub ExcelToAccess()
    On Error GoTo errHandle

    '***ACCESS DAO OBJECTS**********************************
    Dim WS As DAO.Workspace
    Dim DB As DAO.Database
    Dim RS As DAO.Recordset

    ' Create Microsoft Jet Workspace object
    Set WS = CreateWorkspace("ws1", "admin", "", dbUseJet)
    ' Open Database object for Microsoft Jet database
    Set DB = WS.OpenDatabase(myPath & myAccess, False)
    ' Open recordset object for write
    Set RS = DB.OpenRecordset("Table1", dbOpenDynaset)
    ' Open recordset object for read-only
    'Set rs = db.OpenRecordset("Table1", dbOpenSnapshot)
    '***ACCESS DAO OBJECTS**********************************


    '***EXCEL OBJECTS*************************************
    Set mExcel = New Excel.Application 'INIT EXCEL OBJECT
    mExcel.Visible = False 'HIDE EXCEL
    'mExcel.Visible = True 'SHOW EXCEL
    mExcel.Workbooks.Open myPath & myExcel 'OPEN XLS FILE

    Dim ROW As Integer 'ROW
    Dim WB1 As Object 'WORKBOOK
    Dim SH1 As Worksheet 'WORKSHEET

    Set WB1 = mExcel.Application.ActiveWorkbook
    Set SH1 = WB1.ActiveSheet
    '***EXCEL OBJECTS*************************************


    '*****************************************************
    'GET VALUES FROM EXCEL CELLS AND PUT INTO ACCESS TABLE
    Dim Count As Integer
    For ROW = 1 To 6
    RS.AddNew 'ADD NEW RECORD IN ACCESS
    RS!Title = SH1.Rows.Cells(ROW, 1) 'TABLE1[TITLE] = CELL[TITLE]
    RS!Year = SH1.Rows.Cells(ROW, 2) 'TABLE1[YEAR] = CELL[YEAR]
    RS.Update 'SAVE TABLE1 RECORD IN ACCESS
    Count = Count + 1
    Next 'NEXT CELL
    '*****************************************************

    xit:
    'CLOSE ACCESS-DAO OBJECTS
    RS.Close
    DB.Close
    WS.Close
    xit2:
    'RELEASE ACCESS-DAO OBJECTS
    Set RS = Nothing
    Set DB = Nothing
    Set DB = Nothing

    'QUIT EXCEL
    mExcel.Quit
    Set mExcel = Nothing

    MsgBox "Records inserted:" & Count, vbInformation, "Done!"
    Exit Sub


    errHandle:
    If Err.Number = 91 Then Resume xit2
    MsgBox Err.Description, vbCritical, Err.Number
    Resume xit
    End Sub
    [/code]
  • mOskimOski Member Posts: 44
    : see uploaded files-
    : this example automates excel and uses dao to add the excel data to
    : access
    :
    : [code]:
    : Option Explicit
    :
    :
    : 'VB6 MENU - PROJECT , REFERENCES, set a reference to:
    : 'Microsoft Excel 10.0 Object Library
    : 'Microsoft DAO 3.60 Object Library
    :
    : Const myExcel = "_Excel.xls" 'EXCEL FILE
    : Const myAccess = "_Access.mdb" 'ACCESS FILE
    : Dim myPath As String 'PATH (IN SAME FOLDER)
    :
    : Private mExcel As Excel.Application 'EXCEL
    :
    :
    : Private Sub Form_Load()
    : 'INIT PROJECT PATH
    : myPath = App.Path + ""
    : End Sub
    :
    :
    : Private Sub Command1_Click()
    : ExcelToAccess
    : End Sub
    :
    :
    :
    :
    : Sub ExcelToAccess()
    : On Error GoTo errHandle
    :
    : '***ACCESS DAO OBJECTS**********************************
    : Dim WS As DAO.Workspace
    : Dim DB As DAO.Database
    : Dim RS As DAO.Recordset
    :
    : ' Create Microsoft Jet Workspace object
    : Set WS = CreateWorkspace("ws1", "admin", "", dbUseJet)
    : ' Open Database object for Microsoft Jet database
    : Set DB = WS.OpenDatabase(myPath & myAccess, False)
    : ' Open recordset object for write
    : Set RS = DB.OpenRecordset("Table1", dbOpenDynaset)
    : ' Open recordset object for read-only
    : 'Set rs = db.OpenRecordset("Table1", dbOpenSnapshot)
    : '***ACCESS DAO OBJECTS**********************************
    :
    :
    : '***EXCEL OBJECTS*************************************
    : Set mExcel = New Excel.Application 'INIT EXCEL OBJECT
    : mExcel.Visible = False 'HIDE EXCEL
    : 'mExcel.Visible = True 'SHOW EXCEL
    : mExcel.Workbooks.Open myPath & myExcel 'OPEN XLS FILE
    :
    : Dim ROW As Integer 'ROW
    : Dim WB1 As Object 'WORKBOOK
    : Dim SH1 As Worksheet 'WORKSHEET
    :
    : Set WB1 = mExcel.Application.ActiveWorkbook
    : Set SH1 = WB1.ActiveSheet
    : '***EXCEL OBJECTS*************************************
    :
    :
    : '*****************************************************
    : 'GET VALUES FROM EXCEL CELLS AND PUT INTO ACCESS TABLE
    : Dim Count As Integer
    : For ROW = 1 To 6
    : RS.AddNew 'ADD NEW RECORD IN ACCESS
    : RS!Title = SH1.Rows.Cells(ROW, 1) 'TABLE1[TITLE] = CELL[TITLE]
    : RS!Year = SH1.Rows.Cells(ROW, 2) 'TABLE1[YEAR] = CELL[YEAR]
    : RS.Update 'SAVE TABLE1 RECORD IN ACCESS
    : Count = Count + 1
    : Next 'NEXT CELL
    : '*****************************************************
    :
    : xit:
    : 'CLOSE ACCESS-DAO OBJECTS
    : RS.Close
    : DB.Close
    : WS.Close
    : xit2:
    : 'RELEASE ACCESS-DAO OBJECTS
    : Set RS = Nothing
    : Set DB = Nothing
    : Set DB = Nothing
    :
    : 'QUIT EXCEL
    : mExcel.Quit
    : Set mExcel = Nothing
    :
    : MsgBox "Records inserted:" & Count, vbInformation, "Done!"
    : Exit Sub
    :
    :
    : errHandle:
    : If Err.Number = 91 Then Resume xit2
    : MsgBox Err.Description, vbCritical, Err.Number
    : Resume xit
    : End Sub
    : [/code]:



    I just tried the code and works! thank you soOoOoOo muCh for the code!

    (^_^)


  • marl24marl24 Member Posts: 20
    Thank you very much..

    : : see uploaded files-
    : : this example automates excel and uses dao to add the excel data to
    : : access
    : :
    : : [code]: :
    : : Option Explicit
    : :
    : :
    : : 'VB6 MENU - PROJECT , REFERENCES, set a reference to:
    : : 'Microsoft Excel 10.0 Object Library
    : : 'Microsoft DAO 3.60 Object Library
    : :
    : : Const myExcel = "_Excel.xls" 'EXCEL FILE
    : : Const myAccess = "_Access.mdb" 'ACCESS FILE
    : : Dim myPath As String 'PATH (IN SAME FOLDER)
    : :
    : : Private mExcel As Excel.Application 'EXCEL
    : :
    : :
    : : Private Sub Form_Load()
    : : 'INIT PROJECT PATH
    : : myPath = App.Path + ""
    : : End Sub
    : :
    : :
    : : Private Sub Command1_Click()
    : : ExcelToAccess
    : : End Sub
    : :
    : :
    : :
    : :
    : : Sub ExcelToAccess()
    : : On Error GoTo errHandle
    : :
    : : '***ACCESS DAO OBJECTS**********************************
    : : Dim WS As DAO.Workspace
    : : Dim DB As DAO.Database
    : : Dim RS As DAO.Recordset
    : :
    : : ' Create Microsoft Jet Workspace object
    : : Set WS = CreateWorkspace("ws1", "admin", "", dbUseJet)
    : : ' Open Database object for Microsoft Jet database
    : : Set DB = WS.OpenDatabase(myPath & myAccess, False)
    : : ' Open recordset object for write
    : : Set RS = DB.OpenRecordset("Table1", dbOpenDynaset)
    : : ' Open recordset object for read-only
    : : 'Set rs = db.OpenRecordset("Table1", dbOpenSnapshot)
    : : '***ACCESS DAO OBJECTS**********************************
    : :
    : :
    : : '***EXCEL OBJECTS*************************************
    : : Set mExcel = New Excel.Application 'INIT EXCEL OBJECT
    : : mExcel.Visible = False 'HIDE EXCEL
    : : 'mExcel.Visible = True 'SHOW EXCEL
    : : mExcel.Workbooks.Open myPath & myExcel 'OPEN XLS FILE
    : :
    : : Dim ROW As Integer 'ROW
    : : Dim WB1 As Object 'WORKBOOK
    : : Dim SH1 As Worksheet 'WORKSHEET
    : :
    : : Set WB1 = mExcel.Application.ActiveWorkbook
    : : Set SH1 = WB1.ActiveSheet
    : : '***EXCEL OBJECTS*************************************
    : :
    : :
    : : '*****************************************************
    : : 'GET VALUES FROM EXCEL CELLS AND PUT INTO ACCESS TABLE
    : : Dim Count As Integer
    : : For ROW = 1 To 6
    : : RS.AddNew 'ADD NEW RECORD IN ACCESS
    : : RS!Title = SH1.Rows.Cells(ROW, 1) 'TABLE1[TITLE] = CELL[TITLE]
    : : RS!Year = SH1.Rows.Cells(ROW, 2) 'TABLE1[YEAR] = CELL[YEAR]
    : : RS.Update 'SAVE TABLE1 RECORD IN ACCESS
    : : Count = Count + 1
    : : Next 'NEXT CELL
    : : '*****************************************************
    : :
    : : xit:
    : : 'CLOSE ACCESS-DAO OBJECTS
    : : RS.Close
    : : DB.Close
    : : WS.Close
    : : xit2:
    : : 'RELEASE ACCESS-DAO OBJECTS
    : : Set RS = Nothing
    : : Set DB = Nothing
    : : Set DB = Nothing
    : :
    : : 'QUIT EXCEL
    : : mExcel.Quit
    : : Set mExcel = Nothing
    : :
    : : MsgBox "Records inserted:" & Count, vbInformation, "Done!"
    : : Exit Sub
    : :
    : :
    : : errHandle:
    : : If Err.Number = 91 Then Resume xit2
    : : MsgBox Err.Description, vbCritical, Err.Number
    : : Resume xit
    : : End Sub
    : : [/code]: :
    :
    :
    :
    : I just tried the code and works! thank you soOoOoOo muCh for the
    : code!
    :
    : (^_^)
    :
    :
    :
Sign In or Register to comment.