Connect to Access from Excel

[mark curtis]

I have the code below to connect to a access database but I am having trouble creating the recordset and placing it in Excel...any help would be appreciated.

Dim intPID As Integer, i As Integer
Dim oConn As Object
Dim oSheet As Object
Dim oRst As Object
'Dim strSQL As String, strRAGLoc As String
Dim CurrentValue As Variant, CurrentField As Variant

'Open connection and create recordset
Set oConn = CreateObject("ADODB.Connection")
'Make the recordset object
Set oRst = CreateObject("ADODB.Recordset")

oConn.Open "DRIVER={Microsoft Access Driver (*.mdb)};" & _
"DBQ=" & "C:\MC\PSOInventory\10PSODatabase\Tonight\4.8" & "
\PSOInventory.97.4.8.0.mdb"

strSQL = "SELECT tblProduct.ProjectID, tblProduct.ProductName,
tblProduct.ProductDescription, tblProduct.ProductBreakdown1,
tblProduct.ProductBreakdown2, tblProduct.ProductBreakdown3,
tblProduct.ProductBreakdown4, tblProduct.strProductScope,
tblProduct.RevisedDeliveryDate, tblProduct.ActualDeliveryDate,
tblProduct.DeliveryDifferenceReason FROM" & _
"tblDocumentRegister INNER JOIN tblProduct ON
tblDocumentRegister.ProjectID = tblProduct.ProjectID WHERE " & _
"(((tblProduct.strProductScope) = ""yes"") And
((tblProduct.RevisedDeliveryDate) < Now()) And
((tblProduct.ActualDeliveryDate) Is Null)) Or
(((tblProduct.strProductScope) = ""yes"") And
((tblProduct.ActualDeliveryDate) > [RevisedDeliveryDate] + 14));"

 

[ByteMyzer]

How about this code?

Dim iColumn As Integer, iRow As Integer
Dim oDbe As Object
Dim oDbs As Object
Dim oRst As Object
Dim oSheet As Object
Dim strSQL As String

'Set Worksheet
Set oSheet = ActiveSheet

'Open database engine and database
Set oDbe = CreateObject("DAO.DBEngine.35")
Set oDbs = oDbe.OpenDatabase("C:\MC\PSOInventory\10PSODatabase\Tonight\4.8" _
    & "\PSOInventory.97.4.8.0.mdb")

'Set SQL string
strSQL = "SELECT tblProduct.ProjectID, tblProduct.ProductName, " _
    & "tblProduct.ProductDescription, tblProduct.ProductBreakdown1, " _
    & "tblProduct.ProductBreakdown2, tblProduct.ProductBreakdown3, " _
    & "tblProduct.ProductBreakdown4, tblProduct.strProductScope, " _
    & "tblProduct.RevisedDeliveryDate, tblProduct.ActualDeliveryDate, " _
    & "tblProduct.DeliveryDifferenceReason " _
    & "FROM tblDocumentRegister INNER JOIN tblProduct ON " _
    & "tblDocumentRegister.ProjectID = tblProduct.ProjectID " _
    & "WHERE (((tblProduct.strProductScope) = ""yes"") And " _
    & "((tblProduct.RevisedDeliveryDate) < Now()) And " _
    & "((tblProduct.ActualDeliveryDate) Is Null)) Or " _
    & "(((tblProduct.strProductScope) = ""yes"") And " _
    & "((tblProduct.ActualDeliveryDate) > [RevisedDeliveryDate] + 14));"

'Open the recordset object
Set oRst = oDbs.OpenRecordset(strSQL)

'Populate the first row with the field names
iRow = 1
For iColumn = 1 To oRst.Fields.Count
    oSheet.Cells(iRow, iColumn) = oRst.Fields(iColumn - 1).Name
Next iColumn

'Populate successive rows with recordset data
Do While Not oRst.EOF
    iRow = iRow + 1
    For iColumn = 1 To oRst.Fields.Count
        oSheet.Cells(iRow, iColumn) = oRst.Fields(iColumn - 1).Value
    Next iColumn
    oRst.MoveNext
Loop

'Set field names to bold
oSheet.Rows(1).Font.Bold = True

'Autofit data columns
For iColumn = 1 To oRst.Fields.Count
    oSheet.Columns(iColumn).EntireColumn.AutoFit
Next iColumn

'Close objects and release memory
oRst.Close
oDbs.Close
Set oRst = Nothing
Set oDbs = Nothing
Set oDbe = Nothing
Set oSheet = Nothing

 

[mark curtis]

Byte,

Thank you for the reply. I will give it a crack and let you know.

Thanks
Mark

 

[Pat Hartman]

tblProduct.RevisedDeliveryDate) < Now() -- this could return records with today's date if they happened earlier today. Only use Now() when you actually want this behaviour; otherwise use Date().

 

[mark curtis]

Folks,

Tried out the code and it works fine but I have one more problem I can not crack.

Using the SQL below I want to only return data where the the project id in Access = a number that I have stored in a variable called intPID.

'Set SQL string
strSQL = "SELECT tblProduct.ProjectID, tblProduct.ProductName, " _
& "tblProduct.ProductDescription, tblProduct.ProductBreakdown1, " _
& "tblProduct.ProductBreakdown2, tblProduct.ProductBreakdown3, " _
& "tblProduct.ProductBreakdown4, tblProduct.strProductScope, " _
& "tblProduct.RevisedDeliveryDate, tblProduct.ActualDeliveryDate, " _
& "tblProduct.DeliveryDifferenceReason " _
& "FROM tblDocumentRegister INNER JOIN tblProduct ON " _
& "tblDocumentRegister.ProjectID = tblProduct.ProjectID " _
& "WHERE (((tblProduct.strProductScope) = ""yes"") And " _
& "((tblProduct.RevisedDeliveryDate) < Now()) And " _
& "((tblProduct.ActualDeliveryDate) Is Null)) Or " _
& "(((tblProduct.strProductScope) = ""yes"") And " _
& "((tblProduct.ActualDeliveryDate) > [RevisedDeliveryDate] + 14));"

 

[mark curtis]

I've sorted it out thanks..