[Resolvido]Adicionar um campo em tabela via VBA

Bom dia Amigos

Preciso de adicionar um campo numa tabela via VBA numa BD dividida, com password no Back-End

Tentei e não consegui assim:

CurrentDb.Execute ("ALTER TABLE Adiantado ADD COLUMN PorContade2 Text;")


Obrigado

Código:

Dim strCaminhoBe As String
 
strCaminhoBe = "c:\MinhaPasta\meuBd_be.accdb;pwd=MinhaSenha"
 
CurrentDb.Execute "Alter Table [" & strCaminhoBe & "].Adiantado Add Column PorContade2 Text;"

Ivan

Não será possível alterar a linha abaixo por:

strCaminhoBe = "c:\MinhaPasta\meuBd_be.accdb;pwd=MinhaSenha"


Esta abaixo ?

strCaminhoBe = DLookup("path_0", "tblCaminhoBe");pwd=xxxxxxxxx"

Obrigado

strCaminhoBe = DLookup("path_0", "tblCaminhoBe") & ";pwd=xxxxxxxxx"

Ivan

Não precisa da Password, no meu caso não precisou.

Veja a imagem que anexo será possível ?

Assis, é possível, contanto que você faça a montagem correta da SQL a ser executada.

Bom dia a todos;

Veja se serve e adapte ás sua necessidades;

Download

Obrigado JPaulo

Queria para bases de dados divididas .

Assis, me esclareca uma coisa, após criar um campo na tabela como fazer para:

1- Inserir dados no campo recem criado?

2- Como adiciona-lo na consulta, formulario, relatorio?

Vejamos, se o "usuario" tiver acesso ao modo estrutura do accdb, podera proceder as alteracoes mas e se for accde ou houve bloqueio ao modo estrutura?

Faco estas indagacoes porque tenho muito interesse neste assunto.

Tauron

Tenho mais que uma BD todas em ACCDE num País distante, na qual só tenho acesso via TeamViwer .

Todas elas estão divididas Front e Back.

O cliente pede por exemplo para acrescentar mais um campo na tabela XXXXX.


Respondendo ao seu ponto 2

Como eu no meu PC tenho as mesmas BD em ACCDB, adiciono o campo novo na tabela xxxxxx, e no Front preparo o respetivo formulário que envia os dados para a tabela xxxxxxx. e relatórios.


Depois converto o Front ACCDB em ACCDE, que envio pelo  TeamViwer .

Executo o formulário da Imagem abaixo (Este formulário só eu tenho acesso ).



E assim não necessito de fazer o download das tabelas do Cliente para fazer a adição do campo que ele quer adicionar

Obrigado JPaulo

Obrigado Ivan

Consegui resolver

Fico feliz
Obrigado pelo retorno o fórum agradece.

J. Paulo

Última questão neste caso.

Ver imagem.




Obrigado

Não posso testar porque já estou em casa.
Mas pode testar, em vez Number no alter table, substitua por DOUBLE.

J.Paulo

É igual

Obrigado

Olá;

Não estava a entender;

Na lista de valores da combobox "Tipo de Dados";

Código:

"Integer";"Double";"Single";"Long";"Text";"LongText";"Number";"Date";"Currency";"YESNO"

Código:

TEXT: Para um grupo de caracteres ou símbolos de qualquer tipo
LONGTEXT: Para um texto longo (memo), para muitos parágrafos
BIT: Para valores booleanos que podem ser TRUE ou FALSE
COUNTER: Para números naturais gerados automaticamente adicionados ao campo (autonumber)
BYTE: Para pequenos números (2 digitos)
INTEGER: Para números grandes (4 digitos)
LONG: Para números grandes (9 digitos)
SINGLE: Para números decimais que não precisam de muita precisão
DOUBLE: Para números decimais que necessitam de precisão
CURRENCY: Para moeda
DATE, TIME, ou DATETIME: Para data hora

Bom dia J.Paulo

Escolher, Number, ou Double é igual

O tamanho de Campo fica sempre Duplo




Obrigado

Certo.

J.Paulo

Está um bocadinho limitado quanto a números.

Falta o formatar, e as casas decimais. Tem como?

Obrigado

Formatar e casas decimais só via código usando as propriedades.
Não estou no trabalho, mas dê uma pesquisada sobre o tema.

J.Paulo

Andei por aqui mas não consigo resolver.

usandoaccess.com.br/dicas/add-alter-column-acrescentar-alterar-vba.asp?id=1&idlista=223#inicio

Aqui;

Código:

http://allenbrowne.com/func-DAO.html

"Set a property for an object, creating if necessary."

Bom dia

J.Paulo

Aqui ?

Mas não chego lá.

Código:

Function SetPropertyDAO(obj As Object, strPropertyName As String, intType As Integer, _
   varValue As Variant, Optional strErrMsg As String) As Boolean
On Error GoTo ErrHandler
   'Purpose:   Set a property for an object, creating if necessary.
   'Arguments: obj = the object whose property should be set.
   '           strPropertyName = the name of the property to set.
   '           intType = the type of property (needed for creating)
   '           varValue = the value to set this property to.
   '           strErrMsg = string to append any error message to.
   
   If HasProperty(obj, strPropertyName) Then
       obj.Properties(strPropertyName) = varValue
   Else
       obj.Properties.Append obj.CreateProperty(strPropertyName, intType, varValue)
   End If
   SetPropertyDAO = True

ExitHandler:
   Exit Function

ErrHandler:
   strErrMsg = strErrMsg & obj.Name & "." & strPropertyName & " not set to " & varValue & _
       ". Error " & Err.Number & " - " & Err.Description & vbCrLf
   Resume ExitHandler
End Function

Assis, em resposta à sua solicitação em MP segue código para seu botão

Código:

On Error GoTo trataerro

    Dim prp As Property

    If Nz(Me!cboTabela.Value) = "" Or Nz(Me!txtNovoCampo.Value) = "" Or Nz(Me!cboTipo.Value) = "" Then
        Exit Sub
    End If

    Call CurrentDb.Execute("Alter Table " & Me!cboTabela.Value & " Add Column " & Me!txtNovoCampo.Value & " " & Me!cboTipo.Value & ";")
   
    If Eval("'" & Nz(Me!cboCasas) & "' not in ('','Automático')") Then
   
        On Error Resume Next
        'CurrentDb.TableDefs(Me!cboTabela.Value).Fields(Me!txtNovoCampo.Value).Properties("DecimalPlaces").Value = Me!cboCasas.Value
       
        If Err Then
            Call Err.Clear
            Set prp = CurrentDb.CreateProperty("DecimalPlaces", dbByte, Me!cboCasas.Value)
            Call CurrentDb.TableDefs(Me!cboTabela.Value).Fields(Me!txtNovoCampo.Value).Properties.Append(prp)
            Set prp = Nothing
        End If
       
        On Error GoTo trataerro
       
    End If

    If Eval("'" & Nz(Me!cboForm) & "' not in ('','Padrão')") Then
   
        On Error Resume Next
        CurrentDb.TableDefs(Me!cboTabela.Value).Fields(Me!txtNovoCampo.Value).Properties("Format").Value = Me!cboForm.Value
       
        If Err Then
            Call Err.Clear
            Set prp = CurrentDb.CreateProperty("Format", dbText, Me!cboForm.Value)
            Call CurrentDb.TableDefs(Me!cboTabela.Value).Fields(Me!txtNovoCampo.Value).Properties.Append(prp)
            Set prp = Nothing
        End If
       
        On Error GoTo trataerro
       
    End If
   
    MsgBox "Alterado com sucesso.", vbInformation, "Sucesso"
   
sair:
    Exit Sub
   
trataerro:
    Call MsgBox(Err.Description, vbCritical, "Erro nº: " & Err.Number, Err.HelpFile, Err.HelpContext)
    Resume sair

Ivan

Terei feito errado ?

Não está a marcar o formato, e as casas decimais

Segue BD

Acabei esquecendo o apóstrofo no início da linha abaixo, retire-o do código
'CurrentDb.TableDefs(Me!cboTabela.Value).Fields(Me!txtNovoCampo.Value).Properties("DecimalPlaces").Value = Me!cboCasas.Value

...

De resto tudo funciona com o código que lhe passei, veja

Obrigado Ivan

Funciona.

Estou a tentar adaptar para Front e End e estou a ter problemas.

Funciona até á linha dupla e acrescenta o campo na tabela, faltando a formatação e as casas decimais


Não sei como me referir a estas linhas

CurrentDb.TableDefs(Me!cboTabelas.Value).Fields(Me!cboCampo.Value).Properties("DecimalPlaces").Value = Me!cboCasas.Value


Dim strCaminhoBe As String

strCaminhoBe = DLookup("path_0", "tblCaminhoBe")

On Error GoTo trataerro

   Dim prp As Property

   If Nz(Me!cboTabelas.Value) = "" Or Nz(Me!cboCampo.Value) = "" Or Nz(Me!cboTipo.Value) = "" Then
       Exit Sub
   End If

    Call CurrentProject.Connection.Execute("Alter Table [" & strCaminhoBe & "].[" & Me.cboTabelas & "] Add Column [" & Me.cboCampo & "] " & Me.cboTipo & ";")


'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------    

   If Eval("'" & Nz(Me!cboCasas) & "' not in ('','Automático')") Then
   
       On Error Resume Next
       CurrentDb.TableDefs(Me!cboTabelas.Value).Fields(Me!cboCampo.Value).Properties("DecimalPlaces").Value = Me!cboCasas.Value
       
       If err Then
           Call err.Clear
           Set prp = CurrentDb.CreateProperty("DecimalPlaces", dbByte, Me!cboCasas.Value)
           Call CurrentDb.TableDefs(Me!cboTabelas.Value).Fields(Me!cboCampo.Value).Properties.Append(prp)
                     
           Set prp = Nothing
       End If
       
       On Error GoTo trataerro
       
   End If

   If Eval("'" & Nz(Me!cboForm) & "' not in ('','Padrão')") Then
   
       On Error Resume Next
       CurrentDb.TableDefs(Me!cboTabelas.Value).Fields(Me!cboCampo.Value).Properties("Format").Value = Me!cboForm.Value
       
       If err Then
           Call err.Clear
           Set prp = CurrentDb.CreateProperty("Format", dbText, Me!cboForm.Value)
           Call CurrentDb.TableDefs(Me!cboTabelas.Value).Fields(Me!cboCampo.Value).Properties.Append(prp)
 
           Set prp = Nothing
       End If
       
       On Error GoTo trataerro
       
   End If
   
MsgBox "Campo Adicionado com Sucesso.", vbInformation, "Sucesso"
Me.cboTabelas = ""
Me.cboCampo = ""
Me.cboTipo = ""
Me.cboForm = ""
Me.cboCasas = ""
sair:
   Exit Sub
   
trataerro:
   Call MsgBox(err.Description, vbCritical, "Erro n?: " & err.Number, err.Helpfile, err.HelpContext)
   Resume sair

Aqui

Boa noite Ivan

No exemplo que me enviou veja o que acontece.

Teste com os mesmos dados da imagem




Veja como fica na tabela



O valor da comboBox formatar não aparece




Obrigado

Escreva Standard que aparecerá a palavra Padrão.

Obrigado Ivan

 Agora Resolvido II  

O fórum agradece. Sucesso.

Aproveitando  o tópico gostaria de saber se tem como incluir um campo calculado igual exemplo abaixo e um valor para o campo "valor predefinido" para outro campo

up