Call Assembler("Make", desttblname, srctbl, , , , exportPath)
Call Assembler("Append", desttblname, srctbl, , , , exportPath)
Public Function Assembler(ByVal strMode As String, ByVal tblName As String, _
Optional ByVal tblSource As String, _
Optional ByVal strFld As String, Optional strParam As String, _
Optional strType As String, _
Optional remoteDatabase As String, _
Optional importPath As String)
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim intNum As Integer
On Error GoTo HandleErr
Set dbs = CurrentDb()
If InStr(tblName, "[") > 0 Then
tblName = Mid(tblName, 2, Len(tblName) - 2)
End If
If InStr(tblSource, "[") > 0 Then
tblSource = Mid(tblSource, 2, Len(tblSource) - 2)
End If
If Len(remoteDatabase) > 0 Then
tblName = "[" & remoteDatabase & "]." & tblName
End If
If Len(importPath) > 0 Then
tblSource = "[" & importPath & "]." & tblSource
End If
If IsNumeric(strFld) Then intNum = strFld
' this is where the error is - intNum isn't getting a valid numeric value
Select Case strMode
Case "delete"
strSQL = "DELETE * FROM " & tblName '& "]"
Case "append"
strSQL = "INSERT INTO " & tblName & " ( " & GetFlds(tblName) & " ) "
strSQL = strSQL & "SELECT " & GetFlds(tblSource, strFld, intNum) & " FROM [" _
& tblSource & "]"
Case "make"
strSQL = "SELECT " & GetFlds(tblSource) & " INTO " & tblName & " FROM " & tblSource
Case Else:
End Select
If Len(strParam) > 0 Then
If InStr(strParam, "Like") Then
strSQL = strSQL & " WHERE " & strParam
Else
strSQL = strSQL & " WHERE " & strFld & " = '" & strParam & "'"
End If
End If
DoCmd.RunSQL strSQL
ExitHere:
Set rs = Nothing
Set dbs = Nothing
End Function
Public Function GetFlds(ByVal MyTable As String, _
Optional HowMany As Integer) As String
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim x, intFields As Integer
On Error GoTo HandleErr
Set dbs = CurrentDb()
If InStr(MyTable, "[") = 0 Then
strSQL = "SELECT * FROM [" & MyTable & "]"
Else
strSQL = "SELECT * FROM " & MyTable
End If
Set rs = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
With rs
' If I'm inserting an additional field at a given position
' then add one to the number of fields now
intFields = .Fields.Count - 1
For x = 0 To intFields
If HowMany > 0 And x > HowMany Then Exit For ' Sets limit on how many fields actually used
If x = myType Then
GetFlds = GetFlds & "' ', "
End If
GetFlds = GetFlds & "[" & .Fields(x).Name & "], "
Next x
If HowMany > intFields + 1 Then ' if need more blank fields, add
For x = x To HowMany
GetFlds = GetFlds & "' ', "
Next x
End If
End With
GetFlds = Trim(Left(GetFlds, Len(GetFlds) - 2))
End Function
