outlook y vb - VB-MUNDO

j · #1 (**permalink**) 03-08-2007, 18:43:30

Hola a todos.
A ver si alguien me puede ayudar.
Estoy haciendo un programa que mediante MAPISESSION y MAPIMESSAGE envia correos electrónicos a distintos destinatarios a traves de outlook.
Todo incluso el envio de correos funciona correctamente es justo después de enviarlo que me da un problema que atribuyo a outlook.
Resulta que una vez enviado el mensaje al volver a trabajar con otro formulario del programa. la ruta de conexión a la BD se cambia o bien el programa interpreta que ha de buscar en la raiz de outlook C:\archivos de programa\outlook\DATOS\nauticas.mdb.

Este es el código que empleo para enviar los correos:

Private Sub cmdEnviar_Click()
Dim i As Integer
Dim id As Long
Dim diario As String
Dim msj As String
Dim sql As String
For i = 1 To cont_nauticas
If txtAsunto.Text = "" Then
msj = MsgBox("Debe propener un ASUNTO", vbOKOnly + vbCritical, "ERROR")
Else
GridEnv.Col = 12
txtdestinatario.Text = GridEnv.Text
GridEnv.Col = 0
id = GridEnv.Text
MAPISession1.NewSession = False
MAPISession1.SignOn

MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Compose

MAPIMessages1.MsgSubject = txtAsunto
MAPIMessages1.MsgNoteText = txtMensaje
MAPIMessages1.RecipDisplayName = txtdestinatario
If lblAdjunto.Caption <> "" Then
MAPIMessages1.AttachmentPathName = lblAdjunto.Caption
End If
MAPIMessages1.Send False
MAPISession1.SignOff
sql = "select c01_d from c01 where c01_id=" & id
rstNautica.Open sql, cnMail, adOpenDynamic, adCmdTable
diario = rstNautica!c01_d
If diario <> "" Then
diario = rstNautica!c01_d & vbCrLf & "Enviado mensaje de correo en:" & Date & " asunto: " & txtAsunto.Text & " Archivo adjunto: " & lblAdjunto.Caption & ""
sql = "UPDATE c01 SET c01_d='" & diario & "' where c01_id=" & id
rstAux.Open sql, cnMail, adOpenDynamic, adCmdTable
Else
diario = "Enviado mensaje de correo en:" & Date & " asunto: " & txtAsunto.Text & " Archivo adjunto: " & lblAdjunto.Caption & ""
sql = "UPDATE c01 SET c01_d='" & diario & "' where c01_id=" & id
rstAux.Open sql, cnMail, adOpenDynamic, adCmdTable
End If
rstNautica.Close
End If
Next i
'Borrar toda la tabla de c06
sql = "select * from c06"
rstAux.Open sql, cnMail, adOpenDynamic, adCmdTable
Do While Not rstAux.EOF
sql = "select * from c06 where c06_id= " & rstAux!c06_id & ""
rstAux2.Open sql, cnMail, adOpenDynamic, adCmdTable
rstAux2.Delete
rstAux.MoveNext
rstAux2.Close
Loop
rstAux.Close
actualiza_grid_2
End Sub

Y este es el que utilizo para la conexión:

'Abre conexión
cnMail.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=DATOS\nauticas.mdb;Persist Security Info=False"
cnMail.Open

A ver si a alguién se le ocurre el porque y como solucionarlo.
Gracias de antemano y saludos a todos.

j · #2 (**permalink**) 26-08-2007, 19:34:35

Bueno amigos
He conseguido solucionarlo y la verdad es que es la solución más sencilla a un problema y a la vez es la que me ha costado más
Igual me estoy haciendo mayor antes de tiempo(jejejeje)
No sé exáctamente porque se ocurre lo descrito en el mensaje anterior pero es así.
Pués bien la solución por si a alguien le ocurre es la siguiente:

strRuta = "provider=microsoft.jet.oledb.4.0; " & "data source=" & App.Path & "\DATOS\nauticas.mdb"
cnMail.Open strRuta

es decir basta con modificar la conexón a la BD mediante la constante App.path
esto lo encontré en éste mismo foro cuando dispuse de un poco de tiempo libre
para investigar.

Gracias a todos.

J.M.Movilla · #3 (**permalink**) 26-08-2007, 21:52:52

Pues si ya has encontrado tú mismo la respuesta, perfecto. Yo iba a decir (por si en otra ocasión te encuentras con un problema parecido y no te sirve la solución actual) que para recuperar la ubicación de un fichero tras haber cambiado de directorio, tienes esta posibilidad:

Código:

Dim cRutaOld As String
cRutaOld = "RutaActualQueQuierasRecuperar"
    '  Aquí el proceso por el que pierdes la ubicación
    '
    '  Recuperamos la ruta con:
ChDir cRutaOld