: see uploaded files-
: this example automates excel and uses dao to add the excel data to
: access
:
:
:
: 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
: :
I just tried the code and works! thank you soOoOoOo muCh for the code!
(^_^)
