Boa noite Pessoal.
Após algumas pesquisas, desenvolvi um sistema para envio de e-mail.
Faço um Select em uma tabela de clientes e jogo o resultado no Windows Live Mail.
Não consegui resolver um problema no anexo de arquivos.
Gostaria de receber sugestões sobre o código abaixo:
----------------------------------------------------------------------------
Form MalaDireta
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
On Error Resume Next 'define o tratamento de erros
cmdlgAnexo.CancelError = True
cmdlgAnexo.ShowOpen
If Err.Number = cdlCancel Then
MsgBox "Você não selecionou nenhum arquivo para anexar a mensagem ! "
Err.Clear
Else
txtAnexo.Text = cmdlgAnexo.FileName
End If
On Error GoTo 0 ' desabilita tratamento de erros
Case 2
Dim arq_anexo As String
Dim assunto As String
Dim Ret As Long
mdfPrincipal.MalaDireta
assunto = txtAssunto.Text
arq_anexo = txtAnexo.Text
'inicia o outlook
ShellExecute Me.hWnd, "Open", "mailto:" & mdfPrincipal.txtEmail.Text & "?subject=Assunto" & arq_anexo & "&body=" & assunto, _
vbNullString, vbNullString, vbNormalFocus
Unload Me
' espera ate que o Outlook Express esteja pronto
'While Ret = 0
' DoEvents
' Ret = FindWindow(vbNullString, arq_anexo)
'Wend
' envia comandos Alt-I-A,o nome do arquivo,
' dois TABs, e Enter.
'SendKeys "%ia" & arq_anexo & "{TAB}{TAB}{ENTER}"
End Select
End Sub
---------------------------------------------------------------------------------
Form Principal
Public Sub MalaDireta()
Dim Contador As Integer
Dim DbVetor As Variant
Dim cnnE As New ADODB.Command
Dim cnnQ As New ADODB.Command
Dim rsQ As New ADODB.Recordset
Dim rsE As New ADODB.Recordset
Dim vSqlC As String
Dim numero_de_colunas As Integer
Dim numero_de_registros As Integer
txtEmail.Text = ""
With cnnQ
.ActiveConnection = cnn
.CommandType = adCmdText
.CommandText = "Select count(EMail) as Qtde from Cliente where EMail <> '';"
Set rsQ = .Execute
End With
With cnnE
.ActiveConnection = cnn
.CommandType = adCmdText
.CommandText = "Select EMail from Cliente where EMail <> '' order by EMail;"
Set rsE = .Execute
End With
DbVetor = rsE.GetRows(rsQ!Qtde)
numero_de_colunas = UBound(DbVetor, 1)
numero_de_registros = UBound(DbVetor, 2)
For i = 0 To numero_de_registros
For j = 0 To numero_de_colunas
Linha = Linha & DbVetor(j, i) & ";"
Next j
txtEmail.Text = Linha
Next i
'Elimina o command e o recordset da memória:
Set rsQ = Nothing
Set rsE = Nothing
Set cnnQ = Nothing
Set cnnE = Nothing
Screen.MousePointer = vbDefault
Exit Sub
End Sub
