hi Jim,
' instead of bloating the FE with temporary tables,
' make another BE and link to its tables.
'~~~~
Function CreateADatabase(psDatabaseName As String) As String
's4p
'RETURN
' path and filename of created database
'CALLS
' GetDatabaseName
CreateADatabase = ""
Dim sPathFileDatabase As String
sPathFileDatabase = GetDatabaseName(psDatabaseName)
'---------------------- create a new database
'make a blank database
DBEngine.CreateDatabase sPathFileDatabase, dbLangGeneral
CreateADatabase = sPathFileDatabase
End Function
'~~~~
Function GetDatabaseName(psDatabaseName As String) As String
's4p
'RETURN
' path\file of a specified database name
Dim sPathFileDatabase As String
If InStr(psDatabaseName, "\") > 0 Then
'if path was specified, use it
sPathFileDatabase = psDatabaseName
Else
'if no path specified, put database in current path
sPathFileDatabase = CurrentProject.Path & "\" & psDatabaseName
End If
'add extension if not specified
If Right(sPathFileDatabase, 6) <> ".accdb" Then
sPathFileDatabase = sPathFileDatabase & ".accdb"
End If
GetDatabaseName = sPathFileDatabase
End Function
'~~~~
Function Link2TableOtherDatabase(psDatabaseName As String _
, psTablename As String)
's4p
'When you are using Make Table and Append queries,
'use the optional IN clause to specify the path and filename of an external database.
'Then use this procedure to link to the table
'CALLS
' GetDatabaseName
' DropTheTable
Dim sPathFileDatabase As String
Dim db As DAO.Database _
, tdf As DAO.TableDef
sPathFileDatabase = GetDatabaseName(psDatabaseName)
'set db to be the current database
Set db = CurrentDb
'if table is already in the current database, delete it
Call DropTheTable(psTablename)
'link to table
With db
Set tdf = .CreateTableDef(psTablename)
tdf.Connect = ";Database=" & sPathFileDatabase
tdf.SourceTableName = psTablename
.TableDefs.Append tdf
.TableDefs.Refresh
End With
'release object variables
Set tdf = Nothing
Set db = Nothing
End Function
'~~~~
Sub DropTheTable( _
sTablename As String _
, Optional pdb As DAO.Database _
)
's4p
'Delete a table
'if the table is not there to delete, no error is returned
'another database may be passed
Dim sName As String
Dim db As DAO.Database
On Error GoTo Proc_Err
If pdb Is Nothing Then
Set db = CurrentDb
Else
Set db = pdb
End If
'See if the table is there
sName = db.TableDefs(sTablename).Name
'If no error then table is there -- delete it
With db
.Execute "DROP TABLE [" & sTablename & "];"
.TableDefs.Refresh
End With
DoEvents
Proc_Exit:
On Error Resume Next
Exit Sub
Proc_Err:
Select Case Err.Number
Case 3265 'Table does not exist
Case Else
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " DropTheTable"
End Select
Resume Proc_Exit
Resume
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~
respectfully,
crystal
~ have an awesome day ~
Hello all,
I recently by this group was told to stop running macros for multiple action queries and use VBA. Also I was told to stop running Make Table Queries. So I converted several macros to the preferred VBA code such as
dbs.Execute "qry_balancethruabovedate", dbFailOnError
So I have been asked to move 2 macros to a new database. Moving forward, I decided to use my new knowledge of these new practices. But one of the macros with queries has an interesting situation I am not sure how to proceed and need some advice.
I have a series of 8 queries in succession that are make table queries. With each make table query the next query uses the previous table created. Then after the 8 make table queries a delete query runs to empty the final table. Then 2 append queries run to append records from 2 of the tables created from the 8 queries to the final table.
These macros were created long ago by my boss who is now retired for which I am now tired. Should I follow the advice from this forum and create delete queries and then append queries through out the entire process? Will this take longer to process if I do that? Or is there a shorter more efficient way of doing this craziness?
Thank You
Jim Wagner
Posted by: crystal 8 <strive4peace2008@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (2) |
Tidak ada komentar:
Posting Komentar