[Resolvidos]Importar Tabelas

Boa tarde amigos.

Se importar uma ou mais tabelas para um Banco de Dados com o nome Ex. TabTESTE, e no banco de dados já existir, essa tabela, a importação é feita mas a tabela importada fica com o nome TabTESTE1. Correcto.
Será possível fazer essa importação mas a tabela TabTESTE original ser apagada, e substituída pela Tabela IMPORTADA? Obrigado

Amigão use esta função para verificar se a tabela existe e chame-a no codigo de importação;

Public Function TableExists(TableName As String) As Boolean

Dim strTableNameCheck
On Error GoTo ErrorCode

strTableNameCheck = CurrentDb.TableDefs(TableName)

TableExists = True

ExitCode:
On Error Resume Next
Exit Function

ErrorCode:
Select Case Err.Number
Case 3265
TableExists = False
Resume ExitCode
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "hlfUtils.TableExists"
Resume ExitCode
End Select

End Function



If TableExists("SuaTabela") = True Then
CurrentDb.TableDefs.Delete "SuaTabela"

Boa noite JPaulo, desde já obrigado pela rápida atenção.
Ainda não tentei aplica a função que me sugeriu.
Isto porque a ideia é a seguinte. Fiz uma base de dados para um amigo que está a 8.500Km de distância. Base de dados essa que está ainda em fase de crescimento. E sempre que existem novas situações, o meu amigo envia-me a base por email, eu elimino as tabelas antigas e faço a importação das tabelas novas(Mais de 39 tabelas). Para lhe reenviar com as novas actualizações.
A ideia final seria fazer a eliminação e a importação de todas as 39 tabelas só com um click.
Obrigado

Bom dia Amigo;

Este código importa todas as tabelas e seus relacionamentos e se já existirem deleta-as.

Código da Microsoft adaptado por mim:

http://dl.dropbox.com/u/771097/ImportaTabelas.txt

Chamar a função:
Call ImportaTodasTabelas("C:\SeuOutroBanco.mdb")

Bom dia JPaulo
Funciona na perfeição
Obrigado

JPaulo tentei usar sua fncao mas esta dando
A sequinte mensagem

Erro de compilacao

Metodos ou membro de dados nao encontrados




Option Explicit

Public Function ImportaTodasTabelas(strPath As String) As Boolean
On Error Resume Next
'codigo da Microsoft adaptado por JPaulo Maximo Access
Dim db As Database 'Database to import
Dim td As TableDef 'Tabledefs in db
Dim strTDef As String 'Name of table or query to import
Dim x As Integer 'For looping
Dim cntContainer As Container 'Containers in db
Dim strDocName As String 'Name of document
Dim intConst As Integer
Dim cdb As Database 'Current Database
Dim rel As Relation 'Relation to copy
Dim nrel As Relation 'Relation to create
Dim strRName As String 'Copied relation's name
Dim strTName As String 'Relation Table name
Dim strFTName As String 'Relation Foreign Table name
Dim varAtt As Variant 'Attributes of relation
Dim fld As Field 'Field(s) in relation to copy
Dim strFName As String 'Name of field to append
Dim strFFName As String 'Foreign name of field to append

Set db = DBEngine.Workspaces(0).OpenDatabase(strPath, True)

For Each td In db.TableDefs

strTDef = td.Name

If TableExists(td.Name) = True Then 'verifica se a tabela já existe
CurrentDb.TableDefs.Delete td.Name 'se existe deleta

If Left(strTDef, 4) <> "MSys" Then
' importa tabelas e relacionamentos
DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, _
strTDef, strTDef, False

End If
End If

Next

Set cdb = CurrentDb

For Each rel In db.Relations

With rel

strRName = .Name
strTName = .Table
strFTName = .ForeignTable
varAtt = .Attributes

Set nrel = cdb.CreateRelation(strRName, strTName, strFTName, varAtt)

For Each fld In .Fields

strFName = fld.Name
strFFName = fld.ForeignName
nrel.Fields.Append nrel.CreateField(strFName)
nrel.Fields(strFName).ForeignName = strFFName

Next

cdb.Relations.Append nrel

End With

Next

Set fld = Nothing
Set cdb = Nothing
Set td = Nothing
Set cntContainer = Nothing

db.Close
Set db = Nothing

ImportaTodasTabelas = True

End Function

Public Function TableExists(TableName As String) As Boolean
Dim strTableNameCheck
On Error GoTo ErrorCode

strTableNameCheck = CurrentDb.TableDefs(TableName)

TableExists = True

ExitCode:
On Error Resume Next
Exit Function

ErrorCode:
Select Case Err.Number
Case 3265
TableExists = False
Resume ExitCode
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "hlfUtils.TableExists"
Resume ExitCode
End Select

End Function

Amigão esse código é da Microsoft não é meu.

ForeignName é a importação dos nomes dos campos da sua ou suas tabelas externas.

Veja também as suas referências no VBA, se não falta alguma, e já agora qual a versão do seu Access.

Valeu Jpaulo consequi resolver o problema, que estava na ordem de prioridade das referencias do VBA.

visual basic for aplication
microsoft access 11,0 object library
ole automation
microsoft dao 3,6 objet library
microsoft activex data objects 2,1 library

Obrigado

Valew.

Olá JPAulo, estou tentando usar essa função as clicar, mas não acontece nada, coloquei o caminho do banco e nada, as referencias estão certas pelo que vi.
Tirei o on resume next para ver o erro e deu isso:

Erro em tempo de execução 3211
O mecanismo de banco de dados não pode bloquear a tabela MSysAccessStorage, pois ela já está sendo usada por outra pessoa ou processo

Alguma LUZ?