USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Por favor ajuda pra enviar arquivo ...
Rafael marques
não registrado
ENUNCIADA !
Postada em 22/12/2005 21:54 hs   
GEnte ... estou procurando uma forma de enviar um email  com um arquivo (em anexo)
achei varias formas mas nao deu certo .. por favor alguem ajude  eu preciso disso com urgencia... me ajudem
obrigado
 
   
Araujolin
CURITIBA
PR - BRASIL
ENUNCIADA !
Postada em 23/12/2005 11:09 hs            
Veja se isso ajuda
 
'Procedimento adaptado por Lindolfo de Araujo Filho
'Este procedimento usa a própria dll do OutlookExpress,
'por isso não precisa de componentes.
'Se o Outlook estiver selecionado a segurança como
'"Avisar quando outro aplicativo tentar enviar email como se fosse eu"
'então aparecerá um alerta pedindo a permissão para enviar,
'o que nào causa problema algum.
                                              Em um Módulo
********************************************************************************************
Option Explicit
Type MAPIMessage
    Reserved As Long
    Subject As String
    NoteText As String
    MessageType As String
    DateReceived As String
    ConversationID As String
    Flags As Long
    RecipCount As Long
    FileCount As Long
End Type
Type MapiRecip
    Reserved As Long
    RecipClass As Long
    Name As String
    Address As String
    EIDSize As Long
    EntryID As String
End Type
Type MapiFile
    Reserved As Long
    Flags As Long
    Position As Long
    PathName As String
    FileName As String
    FileType As String
End Type
'*********************************************************************************
'Altere aqui o caminho da dll MSOE.DLL de acordo com o  seu micro
'*********************************************************************************
Declare Function MAPISendMail Lib "C:Arquivos de programasOutlook ExpressMsoe.dll" _
    Alias "BMAPISendMail" _
    (ByVal Session&, ByVal UIParam&, Message As MAPIMessage, _
    Recipient() As MapiRecip, File() As MapiFile, ByVal Flags&, _
    ByVal Reserved&) As Long
Global Const SUCCESS_SUCCESS = 0
Global Const MAPI_TO = 1
Global Const MAPI_CC = 2
Global Const MAPI_CCO = 3
Global Const MAPI_LOGON_UI = &H1
Function CountTokens(ByVal sSource As String, ByVal sDelim As String)
    Dim iDelimPos As Integer
    Dim iCount As Integer
    If sSource = "" Then
        CountTokens = 0
    Else
        iDelimPos = InStr(1, sSource, sDelim)
        Do Until iDelimPos = 0
            iCount = iCount + 1
            iDelimPos = InStr(iDelimPos + 1, sSource, sDelim)
        Loop
        CountTokens = iCount + IIf(Right(sSource, 1) = sDelim, 0, 1)
    End If
End Function
Function GetToken(sSource As String, ByVal sDelim As String) As String
    Dim iDelimPos As Integer
    ' Busca el primer delimitador
    iDelimPos = InStr(1, sSource, sDelim)
    If (iDelimPos = 0) Then
        GetToken = Trim$(sSource)
        sSource = ""
    Else
        GetToken = Trim$(Left$(sSource, iDelimPos - 1))
        sSource = Mid$(sSource, iDelimPos + 1)
    End If
End Function
Sub ParseTokens(mArray() As String, ByVal sTokens As String, ByVal sDelim As String)
   Dim i As Integer
   For i = LBound(mArray) To UBound(mArray)
      mArray(i) = GetToken(sTokens, sDelim)
   Next
End Sub
' PARAMETROS:
'   sSubject: Es texto que aparecerá como Asunto del mensaje
'   sTo:      Lista delimitada por ";" com os destinatários da mensagem.
'   sCC:      Lista dos destinatários CC (Copia)
'   sCCO:     Lista dos destinatários CCO (Copia oculta)
'   sAttach:  Lista dos anexos a enviar
Function SendMail(sSubject As String, sTo As String, sCC As String, sCCO As String, _
    sAttach As String, sMessage As String)
On Error GoTo Err_CapturarError
   Dim i, cTo, cCC, cCCO, cAttach   ' contadores de items
   Dim MAPI_Message As MAPIMessage
   ' Contar el número de items en cada lista
   cTo = CountTokens(sTo, ";")
   cCC = CountTokens(sCC, ";")
   cCCO = CountTokens(sCCO, ";")
   cAttach = CountTokens(sAttach, ";")
   ' Dimensionar las matrices para las listas
   ReDim rTo(0 To cTo) As String
   ReDim rCC(0 To cCC) As String
   ReDim rCCO(0 To cCCO) As String
   ReDim rAttach(0 To cAttach) As String
   ' Pasar el contenido de las listas a las matrices
   ParseTokens rTo(), sTo, ";"
   ParseTokens rCC(), sCC, ";"
   ParseTokens rCCO(), sCCO, ";"
   ParseTokens rAttach(), sAttach, ";"
   ' Crear la estructura MAPI Recip para almacenar todos los destinatarios
   ReDim MAPI_Recip(0 To cTo + cCC + cCCO - 1) As MapiRecip
   ' Cargar los "TO:" en la estructura
   For i = 0 To cTo - 1
      MAPI_Recip(i).Name = rTo(i)
      MAPI_Recip(i).RecipClass = MAPI_TO
   Next i
   ' Cargar los "CC:"
   For i = 0 To cCC - 1
      MAPI_Recip(cTo + i).Name = rCC(i)
      MAPI_Recip(cTo + i).RecipClass = MAPI_CC
   Next i
   ' Cargar los "CCO:"
   For i = 0 To cCCO - 1
      MAPI_Recip(cTo + cCC + i).Name = rCCO(i)
      MAPI_Recip(cTo + cCC + i).RecipClass = MAPI_CCO
   Next i
   ' Crear la estructura MAPI_File para los adjuntos
   ReDim MAPI_File(0 To cAttach) As MapiFile
   ' Cargar los adjuntos en la estructura
   MAPI_Message.FileCount = cAttach
   For i = 0 To cAttach - 1
      MAPI_File(i).Position = -1
      MAPI_File(i).PathName = rAttach(i)
   Next i
   ' Llenar los campos del mensaje
   MAPI_Message.Subject = sSubject
   MAPI_Message.NoteText = sMessage
   MAPI_Message.RecipCount = cTo + cCC + cCCO
   ' Enviar el mensaje
   SendMail = MAPISendMail(0&, 0&, MAPI_Message, MAPI_Recip(), _
        MAPI_File(), MAPI_LOGON_UI, 0&)
Salida:
    Exit Function
Err_CapturarError:
    Select Case Err.Number
        Case 48
            'Error: No se encontró el archivo: C:Archivos de programa _
                Outlook ExpressMsoe.dll
            SendMail = 48
        Case 453
            'Error: Imposible encontra el punto de entrada de DLL BMAPISendMail en _
                MAPI32X.DLL
            'Asignar el número de error. El filtro y el mensaje más adelante.
            SendMail = 453
        Case Else
            'Cazar todos aquellos errores inesperados.
            MsgBox Err.Number & " " & Err.Description
    End Select
    Resume Salida           'Salida a otro procedimiento.
End Function
                                  No Controle Desejado
********************************************************************************************
On Error GoTo sai
Dim lngRet As Long
'Envia a mensagem
    lngRet = SendMail(("ASSUNTO"), ("destinatario@para"), ("destinatario@comcopia"), ("destinatario@comcopiaoculta"), ("C:AraujoAnexo.txt"), ("TEXTO DA MENSAGEM"))
    Exit Sub
sai:
    'Se ocorrer erro
    If lngRet <> SUCCESS_SUCCESS Then
        Select Case lngRet
            Case 2
                MsgBox "Error nº.: " & lngRet & ", ao enviar email." & vbCr & vbCr _
                    & "Verifique a origem do arquivo anexado. ", vbCritical, "ERRO"
            Case 48
                MsgBox "Error nº.: " & lngRet & ", ao enviar email." & vbCr & vbCr _
                    & "Não foi possível carregar MSOE.DLL", 16, "ERRO"
            Case 453
                MsgBox "Error nº.: " & lngRet & " (de MSAccess), ao enviar email." _
                    & vbCr & vbCr _
                    & "MAPI32X.DLL, não é a versão correta.", vbCritical, "ERRO"
            Case -2147467259
                MsgBox "Error nº.: " & lngRet & ", ao enviar email." & vbCr & vbCr _
                    & "MAPI32.DLL, não é a versão correta.", vbCritical, "ERRO"
            Case Else
                MsgBox "Erro ao enviar email: " & lngRet, vbCritical, "ERRO"
        End Select
    End If

ALF-Sistemas (Araujo Lindolfo Filho)

http://araujolin.vilabol.uol.com.br/index.htm

   
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página