Using Excel to Open an Access Database

[gheyman]

I want to open my access database from my excel sheet which has the file path in a cell.

Sub GetPath07()
    Dim FName As Variant
    FName = Application.GetOpenFilename(filefilter:="Access Files,*.acc*")
    Sheet1.Range("B18").Value = FName
 End Sub

is there a way to open this database? And Can I indicate which from to open in the code or do I have to do that part in access?

Sub Export_Data()
'Export to Access CMOP Database
'
UserId
Timestamp

Dim tbl As ListObject
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

'Set tbl = ThisWorkbook.Sheets("CMOUpload").ListObjects("CMOPTable")

' connect to the Access database
Set cn = New ADODB.Connection
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Sheet1.Range("B18").Value 'Data Source=E:\Development Activities\Freelancer\Projects\In Progress\Upload data from Excel to an Access database - from excel - Greg\Database1.accdb"

' open a recordset
Set rs = New ADODB.Recordset
rs.Open "tbl_CMOP", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 1 ' the start row in the worksheet
Do While r <= Range("CMOPTable").Rows.Count
' repeat until first empty cell in column A
With rs
.AddNew 'create a new record
'add values to each field in the record

.Fields("ItemID") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[ItemID]").Cells(r)
.Fields("ItemDescription") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[ItemDescription]").Cells(r)
.Fields("Rev") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[Rev]").Cells(r)
.Fields("UM") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[UM]").Cells(r)
.Fields("CommCode") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[CommCode]").Cells(r)
.Fields("BuyerID") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[BuyerID]").Cells(r)
.Fields("Buyer") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[Buyer]").Cells(r)
.Fields("VendorID") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[VendorID]").Cells(r)
.Fields("DRSProgram") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[DRSProgram]").Cells(r)
.Fields("ReqNum") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[ReqNum]").Cells(r)
.Fields("DRSRFQID") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[DRSRFQID]").Cells(r)
.Fields("Userstamp") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[UserStamp]").Cells(r)
.Fields("DRSRFQID") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[DRSRFQID]").Cells(r)
.Fields("SolicitationDate") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[SolicitationDate]").Cells(r)
.Fields("VendorQuoteID") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[VendorQuoteID]").Cells(r)
.Fields("QuoteRev") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[QuoteRev]").Cells(r)

'******************
'User Should Enter a Date Only
'Need code here that if the code errors bacuase of one of the next two lines, error message saying data must
'_be a valid date.  And then code stops so that it doesnt debug erro
'******************

.Fields("QuoteDate") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[QuoteDate]").Cells(r)
.Fields("QuoteExpiration") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[QuoteExpiration]").Cells(r)

'******************
'User Should Enter Number Values Only
'Need code here that if the code errors bacuase of one of the next two lines, error message saying data must
'_be a whole Number.  And then code stops so that it doesnt debug erro
'******************
.Fields("LeadTime") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[LeadTime]").Cells(r)
.Fields("MOQ") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[MOQ]").Cells(r)

'******************
'User Should Enter Dollar/Number Values Only
'Need code here that if the code errors, an error message saying data must
'_be a dollar value.  And then code stops so that it doesnt debug erro
'******************

.Fields("UnitPrice") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[UnitPrice]").Cells(r)
.Fields("R1") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R1]").Cells(r)
.Fields("R5") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R5]").Cells(r)
.Fields("R10") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R10]").Cells(r)
.Fields("R25") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R25]").Cells(r)
.Fields("R50") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R50]").Cells(r)
.Fields("R75") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R75]").Cells(r)
.Fields("R100") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R100]").Cells(r)
.Fields("R250") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R250]").Cells(r)
.Fields("R500") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R500]").Cells(r)
.Fields("R750") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R750]").Cells(r)
.Fields("R1000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R1000]").Cells(r)
.Fields("R2000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R2000]").Cells(r)
.Fields("R3000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R3000]").Cells(r)
.Fields("R5000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R5000]").Cells(r)
.Fields("R6000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R6000]").Cells(r)
.Fields("R7500") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R7500]").Cells(r)
.Fields("R10000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R10000]").Cells(r)
.Fields("R13000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R13000]").Cells(r)
.Fields("R15000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R15000]").Cells(r)
.Fields("R20000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R20000]").Cells(r)
.Fields("R23000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R23000]").Cells(r)
.Fields("R26000") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[R26000]").Cells(r)
.Fields("NRE") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[NRE]").Cells(r)
.Fields("SetUpCharge") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[SetUpCharge]").Cells(r)
.Fields("FAI") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[FAI]").Cells(r)
.Fields("1E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[1E]").Cells(r)
.Fields("5E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[5E]").Cells(r)
.Fields("10E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[10E]").Cells(r)
.Fields("25E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[25E]").Cells(r)
.Fields("50E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[50E]").Cells(r)
.Fields("75E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[75E]").Cells(r)
.Fields("100E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[100E]").Cells(r)
.Fields("200E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[200E]").Cells(r)
.Fields("250E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[250E]").Cells(r)
.Fields("500E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[500E]").Cells(r)
.Fields("750E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[750E]").Cells(r)
.Fields("1000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[1000E]").Cells(r)
.Fields("2000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[2000E]").Cells(r)
.Fields("3000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[3000E]").Cells(r)
.Fields("5000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[5000E]").Cells(r)
.Fields("6000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[6000E]").Cells(r)
.Fields("7500E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[7500E]").Cells(r)
.Fields("10000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[10000E]").Cells(r)
.Fields("13000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[13000E]").Cells(r)
.Fields("15000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[15000E]").Cells(r)
.Fields("20000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[20000E]").Cells(r)
.Fields("23000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[23000E]").Cells(r)
.Fields("26000E") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[26000E]").Cells(r)
.Fields("VendorEscFactor") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[VendorEscFactor]").Cells(r)

'************
'Text Values
'************

.Fields("CageCode") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[CageCode]").Cells(r)
.Fields("NAICSCode") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[NAICSCode]").Cells(r)
.Fields("BusClass") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[BusClass]").Cells(r)
.Fields("BusDesignation") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[BusDesignation]").Cells(r)
.Fields("LineComments") = ThisWorkbook.Worksheets("CMOPUpload").Range("CMOPTable[LineComments]").Cells(r)


.Update 'stores the new record
End With

r = r + 1 'next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Set tbl = Nothing


'communicate with the user
 MsgBox " The data has been successfully sent to the database"

'Update the sheet
 Application.ScreenUpdating = True


 On Error GoTo 0
 Exit Sub
errHandler:

'clear memory
 Set rst = Nothing
 Set cnn = Nothing
 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
 
 End Sub

Thanks for the Help