Access - Enviar mail desde access

   
Vista:

Enviar mail desde access

Publicado por David Siscar  (1 intervención) el 20/03/2009 18:33:22
Llevo varios días intentando enviar varias tablas por correo desde un solo mensaje.
Me he creado una macro y en enviar objeto solo me deja mandar una sola tabla alguien me puede ayudar.
Gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Enviar mail desde access

Publicado por Jefferson (381 intervenciones) el 23/03/2009 20:49:43
Que codigo utilizas para tal funcion...???

Prueba con esto:

1) Crea un modulo y pega esta funcion
Option Compare Database
Public Sub CopiarTabasRelaciones(strFile As String)
' Funcion para copiar solo las tablas de la base de datos
' y sus relaciones
' strFile - es el nombre que le vas a dar a la copia. En este caso yo la llamare copia
' jefferson-jimenez@hotmail.com
On Error GoTo E_Handle
Dim dbFE As Database, dbBE As Database
Dim tdf As TableDef
Dim rel As Relation
Dim fld As Field
Dim astr(1 To 100, 1 To 4) As String
Dim intLoop As Integer, intRelCount As Integer, intTableCount As Integer
Dim strTable As String
Set dbFE = CurrentDb
intLoop = 1
If Len(Dir(strFile)) = 0 Then
Set dbBE = DBEngine(0).CreateDatabase(strFile, dbLangGeneral)
Else
Set dbBE = DBEngine(0).OpenDatabase(strFile)
End If
For Each rel In dbFE.Relations
For Each fld In rel.Fields
astr(intLoop, 1) = rel.Table
astr(intLoop, 2) = rel.ForeignTable
astr(intLoop, 3) = fld.Name
astr(intLoop, 4) = fld.ForeignName
intLoop = intLoop + 1
Next fld
Next rel
intRelCount = dbFE.Relations.Count - 1
For intLoop = intRelCount To 0 Step -1
dbFE.Relations.Delete dbFE.Relations(intLoop).Name
Next intLoop
intTableCount = dbFE.TableDefs.Count - 1
For intLoop = intTableCount To 0 Step -1
strTable = dbFE.TableDefs(intLoop).Name
If Left(strTable, 4) <> "MSys" And Left(strTable, 4) <> "USys" And Len(dbFE.TableDefs(intLoop).Connect) = 0 Then
DoCmd.TransferDatabase acExport, "Microsoft Access", strFile, acTable, strTable, strTable
End If
Next intLoop
For intLoop = 1 To intRelCount + 1
Set rel = dbBE.CreateRelation(astr(intLoop, 1) & astr(intLoop, 2), astr(intLoop, 1), astr(intLoop, 2))
rel.Fields.Append rel.CreateField(astr(intLoop, 3))
rel.Fields(astr(intLoop, 3)).ForeignName = astr(intLoop, 4)
dbBE.Relations.Append rel
Next intLoop
sExit:
On Error Resume Next
Set rel = Nothing
Set dbFE = Nothing
dbBE.Close
Set dbBE = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & "CopiarTabasRelaciones", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub

Public Function MensajeDeCorreo()
' Aqui enviamos por correo
' jefferson-jimenez@hotmail.com

Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
Set Attamm = myItem.attachments
myItem.Importance = 2 ' Marca el mensaje de correo como importancia alta
myItem.ReadReceiptRequested = True 'Solicita confirmación de recibo
myItem.To = "jefferson-jimenez@hotmail.com" 'Recuerda cambiar la direccion de correo o me la enviaras a mi, jeje
myItem.Subject = " C O P I A DE T A B L A S " ' El asunto del mail
myItem.Body = " " 'Cuerpo del mail
setnewAttacment = Attamm.Add(CurrentProject.path & "Copia.mdb", olbyvalue) ' Adjuntamos la copia de Tablas de tu base de datos
myItem.Send
End Function

2) Ahora crea un boton de comando en tu formulario al que llamaremos CopiaEnviar

Private sub CopiaEnviar_Click()
Call CopiarTabasRelaciones(CurrentProject.path & "copia.mdb")
MensajeDeCorreo
end sub

3) Recuerda que debes tener configurado el outlook para poder realizar esta funcion

Espero haber Ayudado
Desde Venezuela
Jefferson
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar