Get data from Access file

  • Thread starter Thread starter mjones
  • Start date Start date
Sorry - a formula can't directly impose any formatting on the cell which
contains it: it can only return a value.

You'll need to format the cell the usual way.

Tim






Hi Tim,

I hate to bug you again, but is there a way to make the GetUnitCost
keep the format of the cell it's in, or at least format it to a number
or currency with 2 decimal places?  Some of the costs are coming out
with 4 decimal places.

Thanks again,

Michele
Click to expand...

Naturally, I thought to format the cell directly in the spreadsheet,
i.e. Format > Cells > Number with 2 decimal places, but it just ignors
the format. The values shown look like 15.2263 where some have 2
decimal places, others 3, etc.

Tim, your code is great and I've found another good use for it except
this time, I've getting a few duplicates in the ProductCode field. A
tie breaker is needed. Can I adjust he code to say select Referrer
from tClient where LName and FnameF. In other words, could I say in
the cell =GetUnitCost(A1) except have two values like (A1,A2)?

Thanks again!!
 
See below. You should have a pretty good idea of how it works by now.

Tim


First a small fix for the original function...
'*******************************
Function GetUnitCost(ProdCode)

Const DB_NAME As String = "qcpProg.mdb"
Const SYSDB_NAME As String = "qcpSystem.mdw"
Const DB_PW As String = "myPassword"

Dim retVal As Variant ' ##change here##
Dim conn As Object
Dim rst As Object
Dim sql As String
Dim parentPath As String
Dim dbPath As String, sysdbPath As String

On Error GoTo haveError

parentPath = Left(ThisWorkbook.Path, _
InStrRev(ThisWorkbook.Path, "\"))

dbPath = parentPath & DB_NAME
sysdbPath = parentPath & SYSDB_NAME

retVal = "NoProdCodeSupplied"

If Len(ProdCode) > 0 Then
sql = "select UnitCost from tProduct where " & _
" ProductCode = '" & ProdCode & "'"

Set conn = CreateObject("ADODB.Connection")

conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
dbPath & ";Jet OLEDB:System Database=" & _
sysdbPath & ";User ID=michele;" & _
"Password=" & DB_PW & ";"


Set rst = conn.Execute(sql)
If Not rst.EOF Then
retVal = CDbl(rst.Fields(0).Value) ' ##change here##
Else
retVal = "UnknownProdCode!"
End If

rst.Close
conn.Close
End If

GetUnitCost = retVal

Exit Function

haveError:
GetUnitCost = Err.Description

End Function
'###############################



A new version for your referrer query...
'*******************************
Function GetClientReferrer(FName, LName)

Const DB_NAME As String = "qcpProg.mdb"
Const SYSDB_NAME As String = "qcpSystem.mdw"
Const DB_PW As String = "myPassword"

Dim retVal As string
Dim conn As Object
Dim rst As Object
Dim sql As String
Dim parentPath As String
Dim dbPath As String, sysdbPath As String

On Error GoTo haveError

parentPath = Left(ThisWorkbook.Path, _
InStrRev(ThisWorkbook.Path, "\"))

dbPath = parentPath & DB_NAME
sysdbPath = parentPath & SYSDB_NAME

retVal = "First & Last names required!"

If Len(FName) > 0 and Len(LName) > 0 Then
sql = "select Referrer from tClient where " & _
" FName = '" & FName & "' and " & _
" LName = '" & LName & "'"

Set conn = CreateObject("ADODB.Connection")

conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
dbPath & ";Jet OLEDB:System Database=" & _
sysdbPath & ";User ID=michele;" & _
"Password=" & DB_PW & ";"


Set rst = conn.Execute(sql)
If Not rst.EOF Then
retVal = rst.Fields(0).Value
Else
retVal = "Unknown Client!"
End If

rst.Close
conn.Close
End If

GetClientReferrer = retVal

Exit Function

haveError:
GetClientReferrer = Err.Description

End Function
'###############################


mjones said:
Michele
Click to expand...

Naturally, I thought to format the cell directly in the spreadsheet,
i.e. Format > Cells > Number with 2 decimal places, but it just ignors
the format. The values shown look like 15.2263 where some have 2
decimal places, others 3, etc.

Tim, your code is great and I've found another good use for it except
this time, I've getting a few duplicates in the ProductCode field. A
tie breaker is needed. Can I adjust he code to say select Referrer
from tClient where LName and FnameF. In other words, could I say in
the cell =GetUnitCost(A1) except have two values like (A1,A2)?

Thanks again!!
 
See below.  You should have a pretty good idea of how it works by now.

Tim

First a small fix for the original function...
'*******************************
Function GetUnitCost(ProdCode)

    Const DB_NAME As String = "qcpProg.mdb"
    Const SYSDB_NAME As String = "qcpSystem.mdw"
    Const DB_PW As String = "myPassword"

    Dim retVal As Variant  ' ##change here##
    Dim conn As Object
    Dim rst As Object
    Dim sql As String
    Dim parentPath As String
    Dim dbPath As String, sysdbPath As String

    On Error GoTo haveError

    parentPath = Left(ThisWorkbook.Path, _
                InStrRev(ThisWorkbook.Path, "\"))

    dbPath = parentPath & DB_NAME
    sysdbPath = parentPath & SYSDB_NAME

    retVal = "NoProdCodeSupplied"

    If Len(ProdCode) > 0 Then
        sql = "select UnitCost from tProduct where " & _
              " ProductCode = '" & ProdCode & "'"

        Set conn = CreateObject("ADODB.Connection")

        conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
                   dbPath & ";Jet OLEDB:System Database=" & _
                   sysdbPath & ";User ID=michele;" & _
                   "Password=" & DB_PW & ";"

        Set rst = conn.Execute(sql)
        If Not rst.EOF Then
            retVal = CDbl(rst.Fields(0).Value)  ' ##change here##
        Else
            retVal = "UnknownProdCode!"
        End If

        rst.Close
        conn.Close
    End If

    GetUnitCost = retVal

    Exit Function

haveError:
    GetUnitCost = Err.Description

End Function
'###############################

A new version for your referrer query...
'*******************************
Function GetClientReferrer(FName, LName)

    Const DB_NAME As String = "qcpProg.mdb"
    Const SYSDB_NAME As String = "qcpSystem.mdw"
    Const DB_PW As String = "myPassword"

    Dim retVal As string
    Dim conn As Object
    Dim rst As Object
    Dim sql As String
    Dim parentPath As String
    Dim dbPath As String, sysdbPath As String

    On Error GoTo haveError

    parentPath = Left(ThisWorkbook.Path, _
                InStrRev(ThisWorkbook.Path, "\"))

    dbPath = parentPath & DB_NAME
    sysdbPath = parentPath & SYSDB_NAME

    retVal = "First & Last names required!"

    If Len(FName) > 0 and  Len(LName) > 0 Then
        sql = "select Referrer from tClient where " & _
              " FName = '" & FName & "' and " & _
              " LName = '" & LName & "'"

        Set conn = CreateObject("ADODB.Connection")

        conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
                   dbPath & ";Jet OLEDB:System Database=" & _
                   sysdbPath & ";User ID=michele;" & _
                   "Password=" & DB_PW & ";"

        Set rst = conn.Execute(sql)
        If Not rst.EOF Then
            retVal = rst.Fields(0).Value
        Else
            retVal = "Unknown Client!"
        End If

        rst.Close
        conn.Close
    End If

    GetClientReferrer = retVal

    Exit Function

haveError:
    GetClientReferrer = Err.Description

End Function
'###############################




Naturally, I thought to format the cell directly in the spreadsheet,
i.e. Format > Cells > Number with 2 decimal places, but it just ignors
the format.  The values shown look like 15.2263 where some have 2
decimal places, others 3, etc.

Tim, your code is great and I've found another good use for it except
this time, I've getting a few duplicates in the ProductCode field.  A
tie breaker is needed.  Can I adjust he code to say select Referrer
from tClient where LName and FnameF.  In other words, could I say in
the cell =GetUnitCost(A1) except have two values like (A1,A2)?

Thanks again!!
Click to expand...

Perfect! Just great! Yeah yeah!

Sorry for the late response. This board is so active that I almost
lost your post.

Thanks again!
 
Back
Top