Código para pegar dados em tabela em vez de ficar direto no vba

Tenho uma grande duvida.

Vamos explicar utilizando um exemplo do forum

Tem o exemplo de email e ele fica com as informações do servidor no codigo vba.

seria possivel que ele pegasse essas informações em uma tabela.

apenas as informações do servidor ?

Código:

With Config

.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "teste@gmail.com"
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "senha"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Fields.Update
End With


É só usar um Recordset para pesquisar na tabela e colocar no lugar dos dados do servidor. Se necessário, pesquise por Recordset no fórum.

obrigado.
vou estudar sobre o assunto.

mas poderia me dar um exemplo de como ficaria nesse caso ? ajudaria um bocado a entender !!!

Código:

Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblServidores WHERE Servidor='Gmail'")

.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = rs!Servidor
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = rs!Porta

rs.Close
Set rs = Nothing

Quando começar a ler o que o fórum tem sobre Recordset, entenderá melhor.

grandeeeee....

obrigado pela ajuda.

com esse exemplo ja consegui entender melhor.

estou lendo !!!!

obrigado mesmo...

resolvido.

criquio

cheguei a isso. mas não está dando certo.

o que pode esta dando errado?

Código:

Sub EnviarEmail()

On Error GoTo erromail

Dim Mens As Object
Dim Config As Object
Set Mens = CreateObject("CDO.Message")
Set Config = CreateObject("CDO.Configuration")

With Config

Dim rs As Recordset

Dim EmailCDO_be As Database
    Dim tblServidores As Recordset
    Set EmailCDO_be = DBEngine.Workspaces(0).OpenDatabase(CurrentProject.Path & "\EmailCDO_be.mdb", False, False, "MS Access;PWD=123456")
    Set tblServidores = EmailCDO_be.OpenRecordset("Servidor", dbOpenTable)
    Set tblServidores = EmailCDO_be.OpenRecordset("Porta", dbOpenTable)
    Set tblServidores = EmailCDO_be.OpenRecordset("User", dbOpenTable)
    Set tblServidores = EmailCDO_be.OpenRecordset("Password", dbOpenTable)


.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = rs!Servidor
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = rs!Porta
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = rs!User
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = rs!Password
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Fields.Update

rs.Close
Set rs = Nothing

End With

Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = Me.txtNome

If Not IsNull(Me.txtPara) Then
.Sender = Me.txtPara
End If

If Not IsNull(Me.txtCC) Then
.CC = Me.txtCC
End If

If Not IsNull(Me.txtCCO) Then
.BCC = Me.txtCCO
End If

.ReplyTo = "pauloeduardonobre@gmail.com"

.BodyPart.Charset = "utf-8"

.Subject = Me.txtassunto

If Me.grpTipos.Value = 1 Then
.TextBody = Me.txtMensagem & vbCrLf & vbCrLf & "Assinatura" & vbCrLf & "Paulo Eduardo do Vale Nobre Pacheco"
ElseIf Me.grpTipos.Value = 2 Then
.HTMLBody = Replace(Me.txtMensagem, vbCrLf, "<br>") & "<br><br><br><br>Atenciosamente.<br><br>Paulo Eduardo do Vale Nobre Pacheco"
ElseIf Me.grpTipos.Value = 3 Then
.CreateMHTMLBody = Me.txtMensagem

End If

.To = Me.txtPara

Dim L As Long
If Me.lstAnexos.ListCount > 0 Then
For L = 0 To Me.lstAnexos.ListCount - 1
.AddAttachment Me!lstAnexos.Column(0, L)
Next L

Else
End If
.Send
End With

Set Mens = Nothing
Set Config = Nothing
    DoCmd.OpenForm "frmFinalizar"

erromail:
If Err.Number = 13 Then
    Resume Next
ElseIf Err.Number = -2147220979 Then
    DoCmd.Close acForm, "frmProgresso"
    MsgBox "Você inseriu um endereço de email inválido ou inexistente." & vbCrLf & "Verifique o email e tente novamente.", vbOKOnly + vbCritical, "Email inválido"
    DoCmd.Close acForm, "frmFinalizar"
    Me.txtPara.SetFocus
Else
    Resume Next
End If

End Sub

Você só precisa declarar UM Recordset:

Código:

Dim rs As Recordset

Set rs = DBEngine.Workspaces(0).OpenDatabase(CurrentProject.Path & "\EmailCDO_be.mdb", False, False, "MS Access;PWD=123456").OpenRecordset("SELECT * FROM NomeDaTabelaComOsDados WHERE Servidor='" & Me.cboServidores & "'")

.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = rs!Servidor
...

Estou supondo/sugerindo uma combo no formulário, que nesse caso seria a cboServidores, com uma lista de servidores. O servidor escolhido nessa lista será o parâmetro para a pesquisa na tabela.