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
Dim strCaminhoBe As String
strCaminhoBe = "c:\MinhaPasta\meuBd_be.accdb;pwd=MinhaSenha"
CurrentDb.Execute "Alter Table [" & strCaminhoBe & "].Adiantado Add Column PorContade2 Text;"
"Integer";"Double";"Single";"Long";"Text";"LongText";"Number";"Date";"Currency";"YESNO"
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
http://allenbrowne.com/func-DAO.html
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
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
CleberII e crysostomo gostam desta mensagem