HELP, anyone, I get the following error when running the Import_Data() routine. File Not Found:msau8032.dll. So I've looked everywhere for this library, but havebn't found it. All the code is below, plus a bit of the file that is imported into the database
I call Process_Data(), which runs the mc5500.exe app. I then call Import_Data(), which falls over!!!, whats wrong with it????
Option Compare Database
Option Explicit
Function Import_Data()
Dim file_name As String
Dim SITE_NO As String
Dim SURVEY_NO As String
Dim SITE_NAME As String
Dim No_Records As Integer
Dim WADT As Integer
Dim AADT As Integer
Dim GROUP As String
Dim Criteria As String, MyDB As Database, MySet As Recordset
On Error GoTo MyError:
' Get name of file to be imported into the database
file_name = GetFileName()
file_name = Trim(file_name)
' Cancel press on Dialog Box
If file_name = "" Then
Exit Function
End If
' Display the HourGlass on the screen
DoCmd.Hourglass True
' Delete old records in TC_IMPORT
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * From TC_IMPORT"
DoCmd.SetWarnings True
' Import text file to a temp table before appending it
DoCmd.TransferText acImportDelim, "IMPORT_SPEC", "TC_IMPORT", file_name
' Get site number and survey number from temp table
SITE_NO = DFirst("[SITE_NO]", "TC_IMPORT", "")
SURVEY_NO = DFirst("[SURVEY_NO]", "TC_IMPORT", "")
' Count the number of records in the TC_IMPORT table
No_Records = DCount("*", "TC_IMPORT")
'Check to see if the Site_No is in TC_INDEX table
Criteria = "SITE_NO = '" & SITE_NO & "'" ' Define search criteria.
Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set MySet = MyDB.OpenRecordset("TC_INDEX", DB_OPEN_DYNASET) ' Create dynaset.
MySet.FindFirst Criteria ' Locate first occurrence.
If MySet.NoMatch Then
DoCmd.Hourglass False
MsgBox "The Site Number for this file is not in the Database. Enter the site details in table TC_INDEX and try again", 16, "ERROR"
'Quit Sub
Exit Function
Else
GROUP = MySet![GROUP]
End If
MySet.Close ' Close table.
'Check to see if Temp_table has already been appended to the table TC_3C3S
Criteria = "SITE_NO = '" & SITE_NO & "' AND SURVEY_NO = '" & SURVEY_NO & "'" ' Define search criteria.
Set MySet = MyDB.OpenRecordset("TC_3C3S", DB_OPEN_DYNASET) ' Create dynaset.
MySet.FindFirst Criteria ' Locate first occurrence.
If Not MySet.NoMatch Then
DoCmd.Hourglass False
MsgBox "The data has already been imported. Can not import over existing data", 16, "All Ready in Database"
'Quit Sub
Exit Function
Else ' Temp_Table not all ready in Database
DoCmd.SetWarnings False
' Run query to append TC_IMPORT to TC_3C3s table
DoCmd.RunSQL Append_Query()
' Run query to add record to TC_Summary table
'Calaculate WADT for both direction
WADT = Cal_WADT(No_Records)
' Calculate AADT for section of road using traffic count guideline (Nov 94)
AADT = Cal_AADT(SURVEY_NO, WADT, GROUP)
' Add record for lane 1 to TC_Summary , Only half records will be used eg lane 1
DoCmd.RunSQL Summary_Query(CStr(No_Records / 2), 1, WADT, AADT)
' Add record for lane 2 to TC_Summary , Only half records will be used eg lane 2
DoCmd.RunSQL Summary_Query(CStr(No_Records / 2), 2, WADT, AADT)
DoCmd.SetWarnings True
End If
MySet.Close ' Close table.
MyDB.Close ' Close data base
' Turn off Hourglass
DoCmd.Hourglass False
MsgBox "File Import Correctly", 0, "OK"
' Ever thing went Ok EXIT sub before doing error handling stuff
Exit Function
' Error handling routine
MyError:
' Display Error message box and resumes
MsgBox Error(Err)
DoCmd.Hourglass False
MsgBox "Error Importing File. Not Done Correctly", 16, "ERROR"
Exit Function
End Function
Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then 'prop not found
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
'unkown error
ChangeProperty = False
Resume Change_Bye
End If
End Function
Function process_data()
Dim db_dir As String
Dim str_len As Integer
Dim app As String
db_dir = CurrentDb().Name
str_len = Len(db_dir)
db_dir = Left(db_dir, (str_len - 11))
app = db_dir & "MC5500.exe"
Call Shell(app, 1)
End Function
**********************
mc5500.exe produces the following text file
************************
Function GetFileName() As String
' Return path of a file chosen by user in OpenFile dialog box.
' (This function works in conjunction with GetMDBName2 and StringFromSz to
' display a File-Open dialog that prompts user for a file
Const OFN_SHAREAWARE = &H4000
Const OFN_PATHMUSTEXIST = &H800
Const OFN_HIDEREADONLY = &H4
Dim ofn As wlib_GetFileNameInfo
' Fill ofn structure, which is passed to wlib_GetFileName.
ofn.hWndOwner = 0
ofn.szFilter = "Databases (*.txt)|*.txt|All(*.*)|*.*||"
ofn.NFilterIndex = 1
ofn.szTitle = "Select File to Import"
ofn.Flags = OFN_SHAREAWARE Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
ofn.szDefExt = "txt"
' Call wlib_GetFileName function and interpret results.
If (GetMDBName2(ofn, True) = False) Then
GetFileName = StringFromSz(ofn.szFile)
Else
GetFileName = ""
End If
End Function
Private Function GetMDBName2(gfni As wlib_GetFileNameInfo, ByVal fOpen As Integer) As Long
' This function acts as a cover to MSAU_GetFileName in MSAU200.DLL.
' wlib_GetFileName terminates all strings in gfni structure with nulls and
' then calls DLL version of function. Upon returning from MSAU200.DLL, null
' characters are removed from strings in gfni.
Dim lRet As Long
gfni.szFilter = RTrim$(gfni.szFilter) & Chr$(0)
gfni.szCustomFilter = RTrim$(gfni.szCustomFilter) & Chr$(0)
gfni.szFile = RTrim$(gfni.szFile) & Chr$(0)
gfni.szFileTitle = RTrim$(gfni.szFileTitle) & Chr$(0)
gfni.szInitialDir = RTrim$(gfni.szInitialDir) & Chr$(0)
gfni.szTitle = RTrim$(gfni.szTitle) & Chr$(0)
gfni.szDefExt = RTrim$(gfni.szDefExt) & Chr$(0)
lRet = wlib_MSAU_GetFileName(gfni, fOpen)
gfni.szFilter = StringFromSz(gfni.szFilter)
gfni.szCustomFilter = StringFromSz(gfni.szCustomFilter)
gfni.szFile = StringFromSz(gfni.szFile)
gfni.szFileTitle = StringFromSz(gfni.szFileTitle)
gfni.szInitialDir = StringFromSz(gfni.szInitialDir)
gfni.szTitle = StringFromSz(gfni.szTitle)
gfni.szDefExt = StringFromSz(gfni.szDefExt)
GetMDBName2 = lRet
End Function
Private Function StringFromSz(szTmp As String) As String
' If string terminates with nulls, return a truncated string.
Dim ich As Integer
ich = InStr(szTmp, Chr$(0))
If ich Then
StringFromSz = Left$(szTmp, ich - 1)
Else
StringFromSz = szTmp
End If
End Function
00300300,0043,19/10/00,1,12,67,0,7,0,0,0,0,0,0,0,0,0,0
00300300,0043,19/10/00,2,12,57,1,8,0,0,0,0,0,0,0,0,0,0
00300300,0043,19/10/00,1,18,313,5,6,0,1,0,0,0,0,0,0,0,0
00300300,0043,19/10/00,2,18,307,4,10,1,0,0,0,0,0,0,0,0,0
00300300,0043,19/10/00,1,24,53,1,2,0,0,0,0,0,0,0,0,0,0
00300300,0043,19/10/00,2,24,62,3,2,0,0,0,0,0,0,0,0,0,0
00300300,0043,20/10/00,1,6,11,2,0,0,0,0,1,0,1,0,0,0,0
etc.....
