[Resolvido]Chamar função LinkAllTables para ligar a MSSQL

Function LinkAllTables(Server As Variant, database As Variant, OverwriteIfExists As Boolean)

Chamo esta função com " Call LinkAllTables " mas dá-me erro.

poderão me dizer o que é que falta?

Luís Antunes

Olá Luis, poste a função LinkAllTables.
Aparentemente falta parametros ao invocar a função.
Abraço

ahteixeira

Provavelmente. Estou a disponibilizar o código completo para que veja se é por falta de argumentos.

Luís Antunes

Código:

Option Compare Database
'Depois de algumas pesquisas eu encontrei um blog interessante sobre vinculação de tabelas SQL Server em um DB.
'Aqui é o original. Http://stackoverflow.com/questions/1569476...s-2007-database
'Eu modifiquei os scripts para ser mais seletivo e adaptativo. Criar um novo módulo e cole o código para o novo módulo.
'A maioria das alterações foram para a função LinkAllTables.
'1. O script SQL para obter o conjunto de registos tabela do SQL Server foi modificado para só obter as tabelas de usuário.
'uma. O script de idade iria ficar tabelas do sistema, bem como vistas e ligá-los também.
'2. Mudou o While Loop para conectar todas as tabelas de esquema dbo sem o prefixo "dbo_" geralmente adicionado pelo Access e
'usar o nome do esquema como prefixo de todas as outras mesas. (Isto é. Hr_Employees)

Function LinkAllTables(Server As Variant, database As Variant, OverwriteIfExists As Boolean)
On Error GoTo Function_End
'Exemplo de uso (link todas as tabelas no banco de dados "SQLDB" na SQL Server Instância SQO01,
'substituir um tabelas vinculadas existentes.
'"Vincular tabelas" SQL01 "," SQL DB ", true
'"Isso também irá actualizar a ligação, se a definição da tabela subjacente foi modificada
Dim rsTableList As New ADODB.Recordset
Dim sqlTableList As String
sqlTableList = "SELECT [TABLE_SCHEMA] + '.' + [TABLE_NAME] as tableName"
sqlTableList = sqlTableList + " FROM [INFORMATION_SCHEMA].[TABLES]"
sqlTableList = sqlTableList + " INNER JOIN [sys].[all_objects]"
sqlTableList = sqlTableList + " ON [INFORMATION_SCHEMA].[TABLES].TABLE_NAME = [sys].[all_objects].[name]"
sqlTableList = sqlTableList + " WHERE [sys].[all_objects].[type]=N'U' AND [sys].[all_objects].[is_ms_shipped]<>1"

rsTableList.Open sqlTableList, BuildSQLConnectionString(Server, database)
Dim arrSchema As Variant
While Not rsTableList.EOF
arrSchema = Split(rsTableList("tableName"), ".", , vbTextCompare)
If LCase(arrSchema(0)) = "dbo" Then
If LinkTable(arrSchema(1), Server, database, rsTableList("tableName"), OverwriteIfExists) Then
End If
Else
If LinkTable(arrSchema(0) & "_" & arrSchema(1), Server, database, rsTableList("tableName"), OverwriteIfExists) Then
End If
End If
rsTableList.MoveNext
Wend
Function_End:
rsTableList.Close
End Function
Function LinkTable(LinkedTableAlias As Variant, Server As Variant, database As Variant, SourceTableName As Variant, OverwriteIfExists As Boolean)
'Este método também irá actualizar a ligação, se a definição da tabela subjacente tenha sido modificada.
'O parâmetro overwrite fará com que  re-map / atualize o link para a tabela vinculada, mas somente se ela já for uma tabela vinculada.
'Isso não vai substituir uma consulta existente ou a tabela local com o nome especificado no LinkedTableAlias.
'Links para uma tabela SQL Server sem a necessidade de configurar um DSN no Console de ODBC.Dim dbsCurrent As database
Dim tdfLinked As TableDef
' Open a database to which a linked table can be appended.
Set dbsCurrent = CurrentDb()
'Check for and deal with the scenario of the table alias already existing
If TableNameInUse(LinkedTableAlias) Then
If (Not OverwriteIfExists) Then
Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite existing table."
Exit Function
End If
'delete existing table, but only if it is a linked table
If IsLinkedTable(LinkedTableAlias) Then
dbsCurrent.TableDefs.Delete LinkedTableAlias
dbsCurrent.TableDefs.Refresh
Else
Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite an existing query or local table."
Exit Function
End If
End If
'Create a linked table
Set tdfLinked = dbsCurrent.CreateTableDef(LinkedTableAlias)
tdfLinked.SourceTableName = SourceTableName
tdfLinked.Connect = "ODBC;DRIVER={SQL Server};SERVER=" & Server & ";DATABASE=" & database & ";TRUSTED_CONNECTION=yes;"
On Error Resume Next
dbsCurrent.TableDefs.Append tdfLinked
If (Err.Number = 3626) Then 'too many indexes on source table for Access
Err.Clear
On Error GoTo 0
If LinkTable(LinkedTableAlias, Server, database, "vw" & SourceTableName, OverwriteIfExists) Then
Debug.Print "Can't link directly to table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Linked to view '" & "vw" & SourceTableName & "' instead."
LinkTable = True
Else
Debug.Print "Can't link table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Create a view named '" & "vw" & SourceTableName & "' that selects all rows/columns from '" & SourceTableName & "' and try again to circumvent this."
LinkTable = False
End If
Exit Function
End If
On Error GoTo 0
tdfLinked.RefreshLink
LinkTable = True
End Function
Function BuildSQLConnectionString(Server As Variant, DBName As Variant) As String
BuildSQLConnectionString = "Driver={SQL Server};Server=" & Server & ";Database=" & DBName & ";TRUSTED_CONNECTION=yes;"
End Function
Function TableNameInUse(TableName As Variant) As Boolean
'check for local tables, linked tables and queries (they all share the same namespace)
TableNameInUse = DCount("*", "MSYSObjects", "(Type = 4 or type=1 or type=5) AND [Name]='" & TableName & "'") > 0
End Function
Function IsLinkedTable(TableName As Variant) As Boolean
IsLinkedTable = DCount("*", "MSYSObjects", "(Type = 4) AND [Name]='" & TableName & "'") > 0
End Function

Olá, está função é para ligar a um banco de dados SQL.
É o caso que pretende?
Abraço

Esta função seria par ligar tabelas desvinculadas.

Luís Antunes

Sim Luís, mas de uma tabela ACCDB ou MDB não se aplica a este código.

Este código é para vincular/ligar a um banco de dados MicrosoftSql.
Pelo que vi no código será assim:

Código:

call linkalltables ("NomeServidor","NomeBaseDados, true)

Abraço

ahteixeira

Ficou operacional!

Muito obrigado pela ajuda

Luís Antunes

Olá Luis, obrigado pelo retorno, os utilizadores do fórum agradecem.
Nota, alterei título do tópico para ficar mais visível nas buscas.
Abraço