Import Excel Column To Access with Criteria. Help

  • Thread starter Thread starter niuginikiwi
  • Start date Start date
N

niuginikiwi

Scenario:
I have prices of serveral orders that we supply to markets.
Market sends me a spreadsheet with prices on each of our OrderID and
LineNumber.
What I want to do is use the Windows API to browse to an this excel file and
pick import the prices into the price colum in Acesss but before that is
done, I want to compare the OrderID and LineNumber in Access with whats on
Excel and if they match, import its price into the price field.

I have looked everywhere and it does have code snippets and suggestions on
the web but can't find a good example that will help me achieve this.

Can anyone help?
 
Hi Pieter,

Thanks for the help.

I have an excel file which will have the same column headings all the time
but different files are being picked up via email.

Now I got this API module but being a newbie, I dont really know where to
start.
I see you have suggested the code to define the variable, connect Excel and
run update query.

But how do I call that function to open the dialog to select the right Excel
file and pass it as a string and connect that Excel to as linked table to my
DB.

I'd like to press a button which does the above
and then create and run the update query after this

Do you think you could give me a start with that?
I am happy to supply info that will help you understand my need
 
I have this module that I got from Dev Asish which allowes me to browse and
select a Access DB file to refresh my Linked Tables. It works fine.
I thought this could be where I can start.

I have a button which I click which as calls the fRefreshLinks function
which allows me to browse to an Access file and select it to refresh the
table links. Here is the code:

' Code Courtesy of
' Dev Ashish
'
Function fRefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim i As Integer, strDBPath As String, strTbl As String
Dim dbCurr As Database, dbLink As Database
Dim tdfLocal As TableDef
Dim varRet As Variant
Dim strNewPath As String

Const cERR_USERCANCEL = vbObjectError + 1000
Const cERR_NOREMOTETABLE = vbObjectError + 2000

On Local Error GoTo fRefreshLinks_Err

If MsgBox("Are you sure you want to reconnect all Access tables?", _
vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.Raise
cERR_USERCANCEL

'First get all linked tables in a collection
Set collTbls = fGetLinkedTables

'now link all of them
Set dbCurr = CurrentDb

strMsg = "Do you wish to specify a different path for the Access Tables?"

If MsgBox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") =
vbYes Then
strNewPath = fGetMDBName("Please select a new datasource")
Else
strNewPath = vbNullString
End If

For i = collTbls.Count To 1 Step -1
strDBPath = fParsePath(collTbls(i))
strTbl = fParseTable(collTbls(i))
varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
If Left$(strDBPath, 4) = "ODBC" Then
'ODBC Tables
'ODBC Tables handled separately
' Set tdfLocal = dbCurr.TableDefs(strTbl)
' With tdfLocal
' .Connect = pcCONNECT
' .RefreshLink
' collTbls.Remove (strTbl)
' End With
Else
If strNewPath <> vbNullString Then
'Try this first
strDBPath = strNewPath
Else
If Len(Dir(strDBPath)) = 0 Then
'File Doesn't Exist, call GetOpenFileName
strDBPath = fGetMDBName("'" & strDBPath & "' not found.")
If strDBPath = vbNullString Then
'user pressed cancel
Err.Raise cERR_USERCANCEL
End If
End If
End If

'backend database exists
'putting it here since we could have
'tables from multiple sources
Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

'check to see if the table is present in dbLink
strTbl = fParseTable(collTbls(i))
If fIsRemoteTable(dbLink, strTbl) Then
'everything's ok, reconnect
Set tdfLocal = dbCurr.TableDefs(strTbl)
With tdfLocal
.Connect = ";Database=" & strDBPath
.RefreshLink
collTbls.Remove (.name)
End With
Else
Err.Raise cERR_NOREMOTETABLE
End If
End If
Next
fRefreshLinks = True
varRet = SysCmd(acSysCmdClearStatus)
MsgBox "All Access tables were successfully reconnected.", _
vbInformation + vbOKOnly, _
"Success"

fRefreshLinks_End:
Set collTbls = Nothing
Set tdfLocal = Nothing
Set dbLink = Nothing
Set dbCurr = Nothing
Exit Function
fRefreshLinks_Err:
fRefreshLinks = False
Select Case Err
Case 3059:

Case cERR_USERCANCEL:
MsgBox "No Database was specified, couldn't link tables.", _
vbCritical + vbOKOnly, _
"Error in refreshing links."
Resume fRefreshLinks_End
Case cERR_NOREMOTETABLE:
MsgBox "Table '" & strTbl & "' was not found in the database" & _
vbCrLf & dbLink.name & ". Couldn't refresh links", _
vbCritical + vbOKOnly, _
"Error in refreshing links."
Resume fRefreshLinks_End
Case Else:
strMsg = "Error Information..." & vbCrLf & vbCrLf
strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description & vbCrLf
strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
MsgBox strMsg, vbOKOnly + vbCritical, "Error"
Resume fRefreshLinks_End
End Select
End Function

Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
Dim tdf As TableDef
On Error Resume Next
Set tdf = dbRemote.TableDefs(strTbl)
fIsRemoteTable = (Err = 0)
Set tdf = Nothing
End Function

Function fGetMDBName(strIn As String) As String
'Calls GetOpenFileName dialog
Dim strFilter As String

strFilter = ahtAddFilterItem(strFilter, _
"Access Database(*.mdb;
*.accdb;*.accde;*.accdr;*.mda;*.mde;*.mdw) ", _
"*.mdb; *.mda; *accdb; *.accde;*.accdr; *.mde; *.mdw")
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strFilter = ahtAddFilterItem(strFilter, _
"All Files (*.*)", _
"*.*")

fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
OpenFile:=True, _
DialogTitle:=strIn, _
Flags:=ahtOFN_HIDEREADONLY)
End Function

Function fGetLinkedTables() As Collection
'Returns all linked tables
Dim collTables As New Collection
Dim tdf As TableDef, db As Database
Set db = CurrentDb
db.TableDefs.Refresh
For Each tdf In db.TableDefs
With tdf
If Len(.Connect) > 0 Then
If Left$(.Connect, 4) = "ODBC" Then
' collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name
'ODBC Reconnect handled separately
Else
collTables.Add Item:=.name & .Connect, Key:=.name
End If
End If
End With
Next
Set fGetLinkedTables = collTables
Set collTables = Nothing
Set tdf = Nothing
Set db = Nothing
End Function

Function fParsePath(strIn As String) As String
If Left$(strIn, 4) <> "ODBC" Then
fParsePath = Right(strIn, Len(strIn) _
- (InStr(1, strIn, "DATABASE=") + 8))
Else
fParsePath = strIn
End If
End Function

Function fParseTable(strIn As String) As String
fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
End Function
 
Back
Top